- PSIVORAL ;BIR/MLM - ACTIVITY LOGGER FOR PHARMACY EDITS ;Mar 04, 2022@08:06:26
- ;;5.0;INPATIENT MEDICATIONS;**58,135,267,279,319,418,399**;16 DEC 97;Build 64
- ; Reference to ^PS(52.7 is supported by DBIA 2173.
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ;
- EN ; Entry point for updating activity log from Pharmacy.
- D OPI
- ;
- I $G(^PS(55,DFN,"IV",+ON55,1))'=P("REM") S P("FC")="REMARKS^"_$G(^(1))_U_P("REM") D GTFC
- ;
- ADMIN ; Record changes to admin. times.
- I $P($G(^PS(55,DFN,"IV",+ON55,0)),U,11)'=P(11) S P("FC")="ADMINISTRATION TIMES^"_$P($G(^(0)),U,11)_U_P(11) D GTFC
- ;
- INFUS ; Record changes to infusion rate.
- I $P($G(^PS(55,DFN,"IV",+ON55,0)),U,8)'=P(8) S P("FC")="INFUSION RATE^"_$P($G(^(0)),U,8)_U_P(8) D GTFC
- D:P("DTYP")=1 SOL
- ;
- STOP ; Record changes to stop date.
- N ORIGSTDT,CURSTDT,FROMSTDT
- S ORIGSTDT=$$GET1^DIQ(55.01,+ON55_","_DFN,116,"I")
- S CURSTDT=$$GET1^DIQ(55.01,+ON55_","_DFN,.03,"I")
- S FROMSTDT=$S($$GET1^DIQ(55.01,+ON55_","_DFN,100,"I")="D":ORIGSTDT,1:P(3))
- I FROMSTDT'=CURSTDT D
- . S P("FC")="STOP DATE/TIME^",Y=CURSTDT X ^DD("DD")
- . S $P(P("FC"),U,3)=$P(Y,"@")_" "_$P(Y,"@",2),Y=FROMSTDT X ^DD("DD")
- . S $P(P("FC"),U,2)=$P(Y,"@")_" "_$P(Y,"@",2)
- . D GTFC
- K DRGI,DRGN,TDRG,P("AGE"),P("FC")
- ;
- CLNAPT ; Record changes to clinic and appointment date
- N OLCLN
- S OLCLN=$G(^PS(55,DFN,"IV",+ON55,"DSS"))
- I $P(OLCLN,"^")'="",$P(OLCLN,"^")'=$G(P("CLIN")) S P("FC")="CLINIC^"_$P($G(^SC(+$P(OLCLN,"^"),0)),"^")_U_$P($G(^SC(+$G(P("CLIN")),0)),"^") D GTFC
- I $P(OLCLN,"^",2)'="",$P(OLCLN,"^",2)'=$G(P("APPT")) S P("FC")="APPOINTMENT DATE/TIME^"_$P(OLCLN,"^",2)_U_$G(P("APPT")) D GTFC
- ;
- INDICAT ; Record changes to INDICATION
- Q:'$D(P("IND"))
- N OLDVAL
- S OLDVAL=$G(^PS(55,DFN,"IV",+ON55,18))
- I OLDVAL'=P("IND") S P("FC")="INDICATION"_U_OLDVAL_U_P("IND") D GTFC
- ;
- ;End of active log updates
- K P("FC")
- Q
- ;
- SOL ; Record changes to Solutions.
- K TDRG F DRGI=0:0 S DRGI=$O(DRG("SOL",DRGI)) Q:'DRGI S TDRG("NEW",$P(DRG("SOL",DRGI),U))=$P(DRG("SOL",DRGI),U,2,3)
- S P("AGE")="NEW"
- F DRGI=0:0 S DRGI=$O(^PS(55,DFN,"IV",+ON55,"SOL",DRGI)) Q:'DRGI S X=$G(^PS(55,DFN,"IV",+ON55,"SOL",DRGI,0)),DRG=+$P(X,U),TDRG("OLD",+DRG)=$P($G(^PS(52.7,DRG,0)),U)_U_$P(X,U,2) D:$G(TDRG("NEW",DRG))'=$G(TDRG("OLD",DRG)) SOL1
- S P("AGE")="OLD" F DRGI=0:0 S DRG=$O(TDRG("NEW",DRG)) Q:'DRG D:$G(TDRG("NEW",DRG))'=$G(TDRG("OLD",DRG)) SOL1
- Q
- ;
- SOL1 ;
- I '$D(TDRG(P("AGE"),DRG)) S P("FC")="SOLUTION^"_$P($G(TDRG("OLD",DRG)),U)_U_$P($G(TDRG("NEW",DRG)),U) D GTFC
- Q:$G(TDRG("NEW",DRG))=$G(TDRG("OLD",DRG))
- S P("FC")="VOLUME^"_$P($G(TDRG("OLD",DRG)),U,2)_$S($G(TDRG("OLD",DRG))]"":" ("_$P($G(^PS(52.7,DRG,0)),U)_")",1:"")_U_$P($G(TDRG("NEW",DRG)),U,2)_$S($G(TDRG("NEW",DRG))]"":" ("_$P($G(^PS(52.7,DRG,0)),U)_")",1:"") D GTFC
- Q
- ;
- GTFC ; Create field change entry in activity log.
- N TXTCNT,TXTLN
- S ND=$G(^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0)) S:ND="" ND="^55.151^^" S $P(ND,U,3)=$P(ND,U,3)+1,$P(ND,U,4)=$P(ND,U,4)+1,^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0)=ND,^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,$P(ND,U,3),0)=P("FC") K ND
- I $P(P("FC"),U)="OTHER PRINT INFO" D
- .S TXTLN=0 F TXTCNT=0:1 S TXTLN=$O(^PS(55,DFN,"IV",+ON55,10,TXTLN)) Q:'TXTLN S ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,2,TXTLN,0)=$G(^PS(55,DFN,"IV",+ON55,10,TXTLN,0))
- .I TXTCNT S ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,2,0)="^"_+TXTCNT_"^"_+TXTCNT
- .S TXTLN=0 F TXTCNT=0:1 S TXTLN=$O(^PS(53.45,+$G(PSJSYSP),6,TXTLN)) Q:'TXTLN S ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,3,TXTLN,0)=$G(^PS(53.45,+$G(PSJSYSP),6,TXTLN,0))
- .I TXTCNT S ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,3,0)="^"_+TXTCNT_"^"_+TXTCNT S ^PS(53.45,+$G(PSJSYSP),6)=PSIVLN
- .N ACNT,AND S ACNT=+$O(^PS(55,DFN,"IV",+ON55,"A",""),-1) I ACNT S AND="^55.04^"_+ACNT_"^"_+ACNT,^PS(55,DFN,"IV",+ON55,"A",0)=AND
- K ND
- Q
- LOG ; Update activity log (ask for comment.)
- D SETNML55^PSIVORC1
- I $G(P("FC"))["OTHER PRINT INFO" Q:$G(^PS(53.45,+$G(PSJSYSP),6))
- N ON S ON=ON55
- ;PSJPINIT is defined in PSJUTL3.
- S:+$G(PSJPINIT)'>0 PSJPINIT=DUZ
- I $G(PSIVALT)=1,'$G(PSJUNDC) K DA,DIR S DIR(0)="55.04,.04" D ^DIR K DA,DIR S PSIVAL=$S($D(DIRUT):"",1:Y)
- S:$G(PSIVALT)=2 PSIVAL="Action taken using OE/RR options." D ENTACT^PSIVAL
- K TMP
- S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.02)=PSIVREA
- S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.03)=$P(^VA(200,PSJPINIT,0),U)
- S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.04)=$G(PSIVAL)
- S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.06)=PSJPINIT
- D FILE^DIE("","TMP")
- K TMP
- D:$D(PSIVALCK) @PSIVALCK K PSIVALT,PSIVALCK,PSIVAL
- Q
- ;
- OPI ; Record changes to Other print info.
- I $$DIFFOPI^PSJBCMA5(DFN,ON55) S P("FC")="OTHER PRINT INFO^^" D GTFC
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVORAL 4722 printed Jan 18, 2025@03:05:49 Page 2
- PSIVORAL ;BIR/MLM - ACTIVITY LOGGER FOR PHARMACY EDITS ;Mar 04, 2022@08:06:26
- +1 ;;5.0;INPATIENT MEDICATIONS;**58,135,267,279,319,418,399**;16 DEC 97;Build 64
- +2 ; Reference to ^PS(52.7 is supported by DBIA 2173.
- +3 ; Reference to ^PS(55 is supported by DBIA 2191.
- +4 ;
- EN ; Entry point for updating activity log from Pharmacy.
- +1 DO OPI
- +2 ;
- +1 IF $GET(^PS(55,DFN,"IV",+ON55,1))'=P("REM")
- SET P("FC")="REMARKS^"_$GET(^(1))_U_P("REM")
- DO GTFC
- +2 ;
- ADMIN ; Record changes to admin. times.
- +1 IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,0)),U,11)'=P(11)
- SET P("FC")="ADMINISTRATION TIMES^"_$PIECE($GET(^(0)),U,11)_U_P(11)
- DO GTFC
- +2 ;
- INFUS ; Record changes to infusion rate.
- +1 IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,0)),U,8)'=P(8)
- SET P("FC")="INFUSION RATE^"_$PIECE($GET(^(0)),U,8)_U_P(8)
- DO GTFC
- +2 if P("DTYP")=1
- DO SOL
- +3 ;
- STOP ; Record changes to stop date.
- +1 NEW ORIGSTDT,CURSTDT,FROMSTDT
- +2 SET ORIGSTDT=$$GET1^DIQ(55.01,+ON55_","_DFN,116,"I")
- +3 SET CURSTDT=$$GET1^DIQ(55.01,+ON55_","_DFN,.03,"I")
- +4 SET FROMSTDT=$SELECT($$GET1^DIQ(55.01,+ON55_","_DFN,100,"I")="D":ORIGSTDT,1:P(3))
- +5 IF FROMSTDT'=CURSTDT
- Begin DoDot:1
- +6 SET P("FC")="STOP DATE/TIME^"
- SET Y=CURSTDT
- XECUTE ^DD("DD")
- +7 SET $PIECE(P("FC"),U,3)=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- SET Y=FROMSTDT
- XECUTE ^DD("DD")
- +8 SET $PIECE(P("FC"),U,2)=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- +9 DO GTFC
- End DoDot:1
- +10 KILL DRGI,DRGN,TDRG,P("AGE"),P("FC")
- +11 ;
- CLNAPT ; Record changes to clinic and appointment date
- +1 NEW OLCLN
- +2 SET OLCLN=$GET(^PS(55,DFN,"IV",+ON55,"DSS"))
- +3 IF $PIECE(OLCLN,"^")'=""
- IF $PIECE(OLCLN,"^")'=$GET(P("CLIN"))
- SET P("FC")="CLINIC^"_$PIECE($GET(^SC(+$PIECE(OLCLN,"^"),0)),"^")_U_$PIECE($GET(^SC(+$GET(P("CLIN")),0)),"^")
- DO GTFC
- +4 IF $PIECE(OLCLN,"^",2)'=""
- IF $PIECE(OLCLN,"^",2)'=$GET(P("APPT"))
- SET P("FC")="APPOINTMENT DATE/TIME^"_$PIECE(OLCLN,"^",2)_U_$GET(P("APPT"))
- DO GTFC
- +5 ;
- INDICAT ; Record changes to INDICATION
- +1 if '$DATA(P("IND"))
- QUIT
- +2 NEW OLDVAL
- +3 SET OLDVAL=$GET(^PS(55,DFN,"IV",+ON55,18))
- +4 IF OLDVAL'=P("IND")
- SET P("FC")="INDICATION"_U_OLDVAL_U_P("IND")
- DO GTFC
- +5 ;
- +6 ;End of active log updates
- +7 KILL P("FC")
- +8 QUIT
- +9 ;
- SOL ; Record changes to Solutions.
- +1 KILL TDRG
- FOR DRGI=0:0
- SET DRGI=$ORDER(DRG("SOL",DRGI))
- if 'DRGI
- QUIT
- SET TDRG("NEW",$PIECE(DRG("SOL",DRGI),U))=$PIECE(DRG("SOL",DRGI),U,2,3)
- +2 SET P("AGE")="NEW"
- +3 FOR DRGI=0:0
- SET DRGI=$ORDER(^PS(55,DFN,"IV",+ON55,"SOL",DRGI))
- if 'DRGI
- QUIT
- SET X=$GET(^PS(55,DFN,"IV",+ON55,"SOL",DRGI,0))
- SET DRG=+$PIECE(X,U)
- SET TDRG("OLD",+DRG)=$PIECE($GET(^PS(52.7,DRG,0)),U)_U_$PIECE(X,U,2)
- if $GET(TDRG("NEW",DRG))'=$GET(TDRG("OLD",DRG))
- DO SOL1
- +4 SET P("AGE")="OLD"
- FOR DRGI=0:0
- SET DRG=$ORDER(TDRG("NEW",DRG))
- if 'DRG
- QUIT
- if $GET(TDRG("NEW",DRG))'=$GET(TDRG("OLD",DRG))
- DO SOL1
- +5 QUIT
- +6 ;
- SOL1 ;
- +1 IF '$DATA(TDRG(P("AGE"),DRG))
- SET P("FC")="SOLUTION^"_$PIECE($GET(TDRG("OLD",DRG)),U)_U_$PIECE($GET(TDRG("NEW",DRG)),U)
- DO GTFC
- +2 if $GET(TDRG("NEW",DRG))=$GET(TDRG("OLD",DRG))
- QUIT
- +3 SET P("FC")="VOLUME^"_$PIECE($GET(TDRG("OLD",DRG)),U,2)_$SELECT($GET(TDRG("OLD",DRG))]"":" ("_$PIECE($GET(^PS(52.7,DRG,0)),U)_")",1:"")_U_$PIECE($GET(TDRG("NEW",DRG)),U,2)_$SELECT($GET(TDRG("NEW",DRG))]"":" ("_$PIECE($GET(^PS(52.7,DRG,0)),U)_")
- ",1:"")
- DO GTFC
- +4 QUIT
- +5 ;
- GTFC ; Create field change entry in activity log.
- +1 NEW TXTCNT,TXTLN
- +2 SET ND=$GET(^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0))
- if ND=""
- SET ND="^55.151^^"
- SET $PIECE(ND,U,3)=$PIECE(ND,U,3)+1
- SET $PIECE(ND,U,4)=$PIECE(ND,U,4)+1
- SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0)=ND
- SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,$PIECE(ND,U,3),0)=P("FC")
- KILL ND
- +3 IF $PIECE(P("FC"),U)="OTHER PRINT INFO"
- Begin DoDot:1
- +4 SET TXTLN=0
- FOR TXTCNT=0:1
- SET TXTLN=$ORDER(^PS(55,DFN,"IV",+ON55,10,TXTLN))
- if 'TXTLN
- QUIT
- SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,2,TXTLN,0)=$GET(^PS(55,DFN,"IV",+ON55,10,TXTLN,0))
- +5 IF TXTCNT
- SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,2,0)="^"_+TXTCNT_"^"_+TXTCNT
- +6 SET TXTLN=0
- FOR TXTCNT=0:1
- SET TXTLN=$ORDER(^PS(53.45,+$GET(PSJSYSP),6,TXTLN))
- if 'TXTLN
- QUIT
- SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,3,TXTLN,0)=$GET(^PS(53.45,+$GET(PSJSYSP),6,TXTLN,0))
- +7 IF TXTCNT
- SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,3,0)="^"_+TXTCNT_"^"_+TXTCNT
- SET ^PS(53.45,+$GET(PSJSYSP),6)=PSIVLN
- +8 NEW ACNT,AND
- SET ACNT=+$ORDER(^PS(55,DFN,"IV",+ON55,"A",""),-1)
- IF ACNT
- SET AND="^55.04^"_+ACNT_"^"_+ACNT
- SET ^PS(55,DFN,"IV",+ON55,"A",0)=AND
- End DoDot:1
- +9 KILL ND
- +10 QUIT
- LOG ; Update activity log (ask for comment.)
- +1 DO SETNML55^PSIVORC1
- +2 IF $GET(P("FC"))["OTHER PRINT INFO"
- if $GET(^PS(53.45,+$GET(PSJSYSP),6))
- QUIT
- +3 NEW ON
- SET ON=ON55
- +4 ;PSJPINIT is defined in PSJUTL3.
- +5 if +$GET(PSJPINIT)'>0
- SET PSJPINIT=DUZ
- +6 IF $GET(PSIVALT)=1
- IF '$GET(PSJUNDC)
- KILL DA,DIR
- SET DIR(0)="55.04,.04"
- DO ^DIR
- KILL DA,DIR
- SET PSIVAL=$SELECT($DATA(DIRUT):"",1:Y)
- +7 if $GET(PSIVALT)=2
- SET PSIVAL="Action taken using OE/RR options."
- DO ENTACT^PSIVAL
- +8 KILL TMP
- +9 SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.02)=PSIVREA
- +10 SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.03)=$PIECE(^VA(200,PSJPINIT,0),U)
- +11 SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.04)=$GET(PSIVAL)
- +12 SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.06)=PSJPINIT
- +13 DO FILE^DIE("","TMP")
- +14 KILL TMP
- +15 if $DATA(PSIVALCK)
- DO @PSIVALCK
- KILL PSIVALT,PSIVALCK,PSIVAL
- +16 QUIT
- +17 ;
- OPI ; Record changes to Other print info.
- +1 IF $$DIFFOPI^PSJBCMA5(DFN,ON55)
- SET P("FC")="OTHER PRINT INFO^^"
- DO GTFC
- +2 QUIT
- +3 ;