PSJUTL3 ;BIR/MLM-MISC. INPATIENT UTILITIES ;29 OCT 01 / 4:29 PM
;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA# 2191.
; Reference to ^PSSLOCK is supported by DBIA# 2789.
;
EN ;
Q:$$PATCH^XPDUTL("PSJ*5.0*58")
S ZTDTH=$H,ZTRTN="QUEIV^PSJUTL3",ZTIO="",ZTDESC="Inpatient medications - Mark IV orders as verified"
D ^%ZTLOAD
Q
QUEIV ;
D XTMP
NEW DFN,START,PSJX
D NOW^%DTC S START=%
F DFN=0:0 S DFN=$O(^PS(55,DFN)) Q:'DFN D
. S PSJX=$P($G(^PS(55,DFN,5.1)),U,11)
. Q:PSJX=3
. I PSJX=2 D MARKIV(DFN) Q
. D CNIV^PSJUTL1(DFN)
D SEND(START)
Q
XTMP ;
I '$D(^XTMP("PSJ NEW PERSON",0)) D
. NEW X1,X2 S X1=DT,X2=30 D C^%DTC
. S ^XTMP("PSJ NEW PERSON",0)=X_U_DT_U_"Correct changed user names"
Q
;
MARKIV(DFN) ;
;Mark the Verifying Pharmacy field for active order created prior
; to PSJ*5*58
NEW ON,ON55,X,PSJPINIT,PSJIDT,PSJNOW,PSIVACT
Q:'$$L^PSSLOCK(DFN,0)
D NOW^%DTC S PSJNOW=$E(%,1,12)
S PSJIDT=$$INSTLDT^PSJUTL1() I PSJIDT="" S PSJIDT=PSJNOW
S $P(^PS(55,DFN,5.1),U,11)=3
F ON=0:0 S ON=$O(^PS(55,DFN,"IV",ON)) Q:'ON D
. S X=$G(^PS(55,DFN,"IV",ON,2))
. I +X>PSJIDT Q
. S PSJPINIT=$P(X,U,11)
. NEW XX,XX1,PSJIEN
. F XX=0:0 S XX=$O(^PS(55,DFN,"IV",ON,"A",XX)) Q:'XX D
.. NEW PSJX S XX1=$G(^PS(55,DFN,"IV",ON,"A",XX,0))
.. Q:$P(XX1,U,3)=""
.. K PSJIEN S PSJX=""
.. I $P(XX1,U,6)="" D
... D NAME^PSJBCMA1($P(XX1,U,3),,,.PSJIEN)
... S:PSJIEN>0 $P(^PS(55,DFN,"IV",ON,"A",XX,0),U,6)=PSJIEN,XX1=^(0)
.. Q:+$P($G(^PS(55,DFN,"IV",ON,4)),U,4)
.. I $P(XX1,U,2)="F",($P(XX1,U,4)'="FINISHED BY TECHNICIAN") S PSJPINIT=$P(XX1,U,6),PSJX=1
.. S:$G(PSJIEN)=-1 ^XTMP("PSJ NEW PERSON",1,$P(XX1,U,3),DFN,ON,XX)=PSJX
. Q:+PSJPINIT'>0
. Q:+$P($G(^PS(55,DFN,"IV",ON,4)),U,4)
. D VF(ON,DFN,PSJPINIT,PSJNOW)
D UL^PSSLOCK(DFN)
Q
VF(ON,DFN,PSJPINIT,PSJNOW) ; Update verifying pharm and date fields.
K DA,DIE,DR
S PSIVACT=""
S DIE="^PS(55,"_DFN_",""IV"",",DA=ON,DA(1)=DFN
S DR="140////"_PSJPINIT_";141////"_PSJNOW_";142////1" D ^DIE
S ON55=ON,PSIVREA="V",PSIVALT=""
S PSIVAL="AUTO VERIFIED WITH PATCH PSJ*5*58"
D LOG^PSIVORAL K PSIVAL,PSIVALT,PSIVREA
Q
SEND(START) ;
NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,STOP,LINE
D NOW^%DTC S STOP=%
S LINE(1)="Marking prior IV orders as verified started: "_$$FMTE^XLFDT(START)
S LINE(2)="It ran to completion: "_$$FMTE^XLFDT(STOP)
I $O(^XTMP("PSJ NEW PERSON",0)) D
. S LINE(3)=""
. S LINE(4)="Please assign the PSJI ACTIVITY LOG VA200 option to a holder of the"
. S LINE(5)="PSJI MGR key who is familiar with the Pharmacy users to correct any "
. S LINE(6)="names that the software was unable to match to the New Person file (#200)."
S XMSUB="PSJ*5*58 IV Verification",XMTEXT="LINE("
S XMDUZ="PSJ*5*58"
S XMY(+DUZ)="" D ^XMD
Q
PSJUTL3 ;BIR/MLM-MISC. INPATIENT UTILITIES ;29 OCT 01 / 4:29 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191.
+4 ; Reference to ^PSSLOCK is supported by DBIA# 2789.
+5 ;
EN ;
+1 IF $$PATCH^XPDUTL("PSJ*5.0*58")
QUIT
+2 SET ZTDTH=$HOROLOG
SET ZTRTN="QUEIV^PSJUTL3"
SET ZTIO=""
SET ZTDESC="Inpatient medications - Mark IV orders as verified"
+3 DO ^%ZTLOAD
+4 QUIT
QUEIV ;
+1 DO XTMP
+2 NEW DFN,START,PSJX
+3 DO NOW^%DTC
SET START=%
+4 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+5 SET PSJX=$PIECE($GET(^PS(55,DFN,5.1)),U,11)
+6 IF PSJX=3
QUIT
+7 IF PSJX=2
DO MARKIV(DFN)
QUIT
+8 DO CNIV^PSJUTL1(DFN)
End DoDot:1
+9 DO SEND(START)
+10 QUIT
XTMP ;
+1 IF '$DATA(^XTMP("PSJ NEW PERSON",0))
Begin DoDot:1
+2 NEW X1,X2
SET X1=DT
SET X2=30
DO C^%DTC
+3 SET ^XTMP("PSJ NEW PERSON",0)=X_U_DT_U_"Correct changed user names"
End DoDot:1
+4 QUIT
+5 ;
MARKIV(DFN) ;
+1 ;Mark the Verifying Pharmacy field for active order created prior
+2 ; to PSJ*5*58
+3 NEW ON,ON55,X,PSJPINIT,PSJIDT,PSJNOW,PSIVACT
+4 IF '$$L^PSSLOCK(DFN,0)
QUIT
+5 DO NOW^%DTC
SET PSJNOW=$EXTRACT(%,1,12)
+6 SET PSJIDT=$$INSTLDT^PSJUTL1()
IF PSJIDT=""
SET PSJIDT=PSJNOW
+7 SET $PIECE(^PS(55,DFN,5.1),U,11)=3
+8 FOR ON=0:0
SET ON=$ORDER(^PS(55,DFN,"IV",ON))
IF 'ON
QUIT
Begin DoDot:1
+9 SET X=$GET(^PS(55,DFN,"IV",ON,2))
+10 IF +X>PSJIDT
QUIT
+11 SET PSJPINIT=$PIECE(X,U,11)
+12 NEW XX,XX1,PSJIEN
+13 FOR XX=0:0
SET XX=$ORDER(^PS(55,DFN,"IV",ON,"A",XX))
IF 'XX
QUIT
Begin DoDot:2
+14 NEW PSJX
SET XX1=$GET(^PS(55,DFN,"IV",ON,"A",XX,0))
+15 IF $PIECE(XX1,U,3)=""
QUIT
+16 KILL PSJIEN
SET PSJX=""
+17 IF $PIECE(XX1,U,6)=""
Begin DoDot:3
+18 DO NAME^PSJBCMA1($PIECE(XX1,U,3),,,.PSJIEN)
+19 IF PSJIEN>0
SET $PIECE(^PS(55,DFN,"IV",ON,"A",XX,0),U,6)=PSJIEN
SET XX1=^(0)
End DoDot:3
+20 IF +$PIECE($GET(^PS(55,DFN,"IV",ON,4)),U,4)
QUIT
+21 IF $PIECE(XX1,U,2)="F"
IF ($PIECE(XX1,U,4)'="FINISHED BY TECHNICIAN")
SET PSJPINIT=$PIECE(XX1,U,6)
SET PSJX=1
+22 IF $GET(PSJIEN)=-1
SET ^XTMP("PSJ NEW PERSON",1,$PIECE(XX1,U,3),DFN,ON,XX)=PSJX
End DoDot:2
+23 IF +PSJPINIT'>0
QUIT
+24 IF +$PIECE($GET(^PS(55,DFN,"IV",ON,4)),U,4)
QUIT
+25 DO VF(ON,DFN,PSJPINIT,PSJNOW)
End DoDot:1
+26 DO UL^PSSLOCK(DFN)
+27 QUIT
VF(ON,DFN,PSJPINIT,PSJNOW) ; Update verifying pharm and date fields.
+1 KILL DA,DIE,DR
+2 SET PSIVACT=""
+3 SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=ON
SET DA(1)=DFN
+4 SET DR="140////"_PSJPINIT_";141////"_PSJNOW_";142////1"
DO ^DIE
+5 SET ON55=ON
SET PSIVREA="V"
SET PSIVALT=""
+6 SET PSIVAL="AUTO VERIFIED WITH PATCH PSJ*5*58"
+7 DO LOG^PSIVORAL
KILL PSIVAL,PSIVALT,PSIVREA
+8 QUIT
SEND(START) ;
+1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,STOP,LINE
+2 DO NOW^%DTC
SET STOP=%
+3 SET LINE(1)="Marking prior IV orders as verified started: "_$$FMTE^XLFDT(START)
+4 SET LINE(2)="It ran to completion: "_$$FMTE^XLFDT(STOP)
+5 IF $ORDER(^XTMP("PSJ NEW PERSON",0))
Begin DoDot:1
+6 SET LINE(3)=""
+7 SET LINE(4)="Please assign the PSJI ACTIVITY LOG VA200 option to a holder of the"
+8 SET LINE(5)="PSJI MGR key who is familiar with the Pharmacy users to correct any "
+9 SET LINE(6)="names that the software was unable to match to the New Person file (#200)."
End DoDot:1
+10 SET XMSUB="PSJ*5*58 IV Verification"
SET XMTEXT="LINE("
+11 SET XMDUZ="PSJ*5*58"
+12 SET XMY(+DUZ)=""
DO ^XMD
+13 QUIT
