PSJIPST2 ;BIR/LDT-CONVERSION UTILITY TO CHANGE PICK LIST FROM PRIMARY DRUG TO ORDERABLE ITEM ; 15 May 98 / 9:28 AM
;;5.0; INPATIENT MEDICATIONS ;**3**;16 DEC 97
;
DEQPL ;Convert Existing Pick Lists
N S1,S2,S3,S4,CNT,ON,X
S (CNT,S1)=0 F S S1=$O(^PS(53.5,S1)) Q:'S1 D S DA=S1,DIK="^PS(53.5,",DIK(1)=".01^AC1" D EN1^DIK
.F Q:$$LOCK^PSGPLUTL(S1,"PSGPL") H 60
.K ^PS(53.5,"AC",S1),^PS(53.5,"AU",S1)
.S S2=0 F S S2=$O(^PS(53.5,S1,1,S2)) Q:'S2 D
..S S3=0 F S S3=$O(^PS(53.5,S1,1,S2,1,S3)) Q:'S3 D
...S ND=$G(^PS(53.5,S1,1,S2,1,S3,0)) Q:'ND!$P(ND,U,6)
...S S4=$O(^PS(53.5,S1,1,S2,1,S3,1,0)) Q:S4=""
...S X=$G(^PS(53.5,S1,1,S2,1,S3,1,S4,0)),X=+$G(^PS(55,S2,5,+ND,1,+X,0)),OIDA=$P($G(^PSDRUG(+X,2)),U)
...S $P(ND,U,3)="",$P(ND,U,6)=OIDA,^PS(53.5,S1,1,S2,1,S3,0)=ND I $P(ND,U,5) K DA,DIE S DR=".05////1",DIE="^PS(53.5,"_S1_",1,",DA(1)=S1,DA=S2 D ^DIE K DA,DIE
.D UNLOCK^PSGPLUTL(S1,"PSGPL") S CNT=CNT+1
;
;Send mail msg. when PICK LIST CONVERSION has completed.
K XMY,PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="UNIT DOSE PICK LIST CONVERSION",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)="The conversion of the Pick Lists from Primary Drug to Orderable Item ",PSG(2,0)="has been completed.",PSG(3,0)=CNT_" Pick Lists have been converted."
N DIFROM D ^XMD
K PSG,XMY,XMSUB,XMDUZ,XMTEXT
D NOW^%DTC S $P(^PS(59.7,1,20.5),U,3)=%
ACTPK ; activate Pick List options
F PSJPKLST="PSJU PLDEL","PSJU PLAPS","PSJU PLPRG","PSJU PLDP","PSJU EUD","PSJU PL","PSJU RET","PSJU PLRP","PSJU PLATCS","PSJU PLUP" D
.S DIE="^DIC(19,",DA=+$O(^DIC(19,"B",PSJPKLST,0))
.S DR="2///@" D:DA>0 ^DIE
K PSJPKLST,DIE,DA,DR
Q
ENPVNV ; Entry point to begin conversion process to change PV FLAG and NV FLAG
; fields from "" to 0.
;
K ZTSAVE,ZTSK S ZTIO="",ZTDTH=$H,ZTDESC="Conversion of Unit Dose Verification fields",ZTRTN="DEQPVNV^PSJIPST2" D ^%ZTLOAD
;W !!,"The conversion of Unit Dose verification data has",$S($D(ZTSK):"",1:" NOT")," been queued."
D MES^XPDUTL(" ")
S PSJMESSG="The conversion of Unit Dose verification data has"_$S($D(ZTSK):"",1:" NOT")_" been queued." D MES^XPDUTL(PSJMESSG)
;I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
I $D(ZTSK) S PSJMESSG="(to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED." D MES^XPDUTL(PSJMESSG)
Q
DEQPVNV ; Update NV FLAG and PV FLAG fields so they contain 0 instead of ""
; for use by APV and ANV xrefs added on these fields. This only affects
; orders for the current admission.
;
K ^XTMP("PSJPVNV") D NOW^%DTC S X1=X,X2=1 D C^%DTC S ^XTMP("PSJPVNV",0)=X
D NOW^%DTC S PSGDT=+$E(%,1,12),X1=$P(%,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1)
S PSJWD="" F S PSJWD=$O(^DPT("CN",PSJWD)) Q:PSJWD="" S PSJWG=$$WGNM^PSGVBWU(PSJWD) F DFN=0:0 S DFN=$O(^DPT("CN",PSJWD,DFN)) Q:'DFN D
.; removed ref to ^DGPM
.;S PSJPAD=9999999.9999999-$O(^DGPM("ATID1",DFN,0))
.;F PSJST="C","O","OC","P","R" F PSGFD=$S(PSJST="O":PSJPAD,1:PSGODT):0 S PSGFD=$O(^PS(55,DFN,5,"AU",PSJST,PSGFD)) Q:'PSGFD D
.F PSJST="C","O","OC","P","R" F PSGFD=PSGODT:0 S PSGFD=$O(^PS(55,DFN,5,"AU",PSJST,PSGFD)) Q:'PSGFD D
..F PSGORD=0:0 S PSGORD=$O(^PS(55,DFN,5,"AU",PSJST,PSGFD,PSGORD)) Q:'PSGORD D
...S X=$G(^PS(55,DFN,5,PSGORD,4)) S:X]"" $P(X,U,9,10)=+$P(X,U,9)_U_+$P(X,U,10),^(4)=X
...S:'$P(X,U,9) ^PS(55,"APV",DFN,PSGORD)="" S:'$P(X,U,10) ^PS(55,"ANV",DFN,PSGORD)=""
;
MAILPVNV ;Send mail msg. when UNIT DOSE VERIFICATION DATA has completed.
K XMY,PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="Update of Unit Dose Verification Fields",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)="The update of the PV FLAG and NV FLAG fields in the PHARMACY PATIENT",PSG(2,0)="file (#55) has completed."
N DIFROM D ^XMD
K PSG,XMY,XMSUB,XMDUZ,XMTEXT,^XTMP("PSJPVNV")
D NOW^%DTC S $P(^PS(59.7,1,20.5),U)=%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJIPST2 3854 printed Nov 22, 2024@17:17:21 Page 2
PSJIPST2 ;BIR/LDT-CONVERSION UTILITY TO CHANGE PICK LIST FROM PRIMARY DRUG TO ORDERABLE ITEM ; 15 May 98 / 9:28 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**3**;16 DEC 97
+2 ;
DEQPL ;Convert Existing Pick Lists
+1 NEW S1,S2,S3,S4,CNT,ON,X
+2 SET (CNT,S1)=0
FOR
SET S1=$ORDER(^PS(53.5,S1))
if 'S1
QUIT
Begin DoDot:1
+3 FOR
if $$LOCK^PSGPLUTL(S1,"PSGPL")
QUIT
HANG 60
+4 KILL ^PS(53.5,"AC",S1),^PS(53.5,"AU",S1)
+5 SET S2=0
FOR
SET S2=$ORDER(^PS(53.5,S1,1,S2))
if 'S2
QUIT
Begin DoDot:2
+6 SET S3=0
FOR
SET S3=$ORDER(^PS(53.5,S1,1,S2,1,S3))
if 'S3
QUIT
Begin DoDot:3
+7 SET ND=$GET(^PS(53.5,S1,1,S2,1,S3,0))
if 'ND!$PIECE(ND,U,6)
QUIT
+8 SET S4=$ORDER(^PS(53.5,S1,1,S2,1,S3,1,0))
if S4=""
QUIT
+9 SET X=$GET(^PS(53.5,S1,1,S2,1,S3,1,S4,0))
SET X=+$GET(^PS(55,S2,5,+ND,1,+X,0))
SET OIDA=$PIECE($GET(^PSDRUG(+X,2)),U)
+10 SET $PIECE(ND,U,3)=""
SET $PIECE(ND,U,6)=OIDA
SET ^PS(53.5,S1,1,S2,1,S3,0)=ND
IF $PIECE(ND,U,5)
KILL DA,DIE
SET DR=".05////1"
SET DIE="^PS(53.5,"_S1_",1,"
SET DA(1)=S1
SET DA=S2
DO ^DIE
KILL DA,DIE
End DoDot:3
End DoDot:2
+11 DO UNLOCK^PSGPLUTL(S1,"PSGPL")
SET CNT=CNT+1
End DoDot:1
SET DA=S1
SET DIK="^PS(53.5,"
SET DIK(1)=".01^AC1"
DO EN1^DIK
+12 ;
+13 ;Send mail msg. when PICK LIST CONVERSION has completed.
+14 KILL XMY,PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="UNIT DOSE PICK LIST CONVERSION"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+15 SET PSG(1,0)="The conversion of the Pick Lists from Primary Drug to Orderable Item "
SET PSG(2,0)="has been completed."
SET PSG(3,0)=CNT_" Pick Lists have been converted."
+16 NEW DIFROM
DO ^XMD
+17 KILL PSG,XMY,XMSUB,XMDUZ,XMTEXT
+18 DO NOW^%DTC
SET $PIECE(^PS(59.7,1,20.5),U,3)=%
ACTPK ; activate Pick List options
+1 FOR PSJPKLST="PSJU PLDEL","PSJU PLAPS","PSJU PLPRG","PSJU PLDP","PSJU EUD","PSJU PL","PSJU RET","PSJU PLRP","PSJU PLATCS","PSJU PLUP"
Begin DoDot:1
+2 SET DIE="^DIC(19,"
SET DA=+$ORDER(^DIC(19,"B",PSJPKLST,0))
+3 SET DR="2///@"
if DA>0
DO ^DIE
End DoDot:1
+4 KILL PSJPKLST,DIE,DA,DR
+5 QUIT
ENPVNV ; Entry point to begin conversion process to change PV FLAG and NV FLAG
+1 ; fields from "" to 0.
+2 ;
+3 KILL ZTSAVE,ZTSK
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="Conversion of Unit Dose Verification fields"
SET ZTRTN="DEQPVNV^PSJIPST2"
DO ^%ZTLOAD
+4 ;W !!,"The conversion of Unit Dose verification data has",$S($D(ZTSK):"",1:" NOT")," been queued."
+5 DO MES^XPDUTL(" ")
+6 SET PSJMESSG="The conversion of Unit Dose verification data has"_$SELECT($DATA(ZTSK):"",1:" NOT")_" been queued."
DO MES^XPDUTL(PSJMESSG)
+7 ;I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
+8 IF $DATA(ZTSK)
SET PSJMESSG="(to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
DO MES^XPDUTL(PSJMESSG)
+9 QUIT
DEQPVNV ; Update NV FLAG and PV FLAG fields so they contain 0 instead of ""
+1 ; for use by APV and ANV xrefs added on these fields. This only affects
+2 ; orders for the current admission.
+3 ;
+4 KILL ^XTMP("PSJPVNV")
DO NOW^%DTC
SET X1=X
SET X2=1
DO C^%DTC
SET ^XTMP("PSJPVNV",0)=X
+5 DO NOW^%DTC
SET PSGDT=+$EXTRACT(%,1,12)
SET X1=$PIECE(%,".")
SET X2=-2
DO C^%DTC
SET PSGODT=X_(PSGDT#1)
+6 SET PSJWD=""
FOR
SET PSJWD=$ORDER(^DPT("CN",PSJWD))
if PSJWD=""
QUIT
SET PSJWG=$$WGNM^PSGVBWU(PSJWD)
FOR DFN=0:0
SET DFN=$ORDER(^DPT("CN",PSJWD,DFN))
if 'DFN
QUIT
Begin DoDot:1
+7 ; removed ref to ^DGPM
+8 ;S PSJPAD=9999999.9999999-$O(^DGPM("ATID1",DFN,0))
+9 ;F PSJST="C","O","OC","P","R" F PSGFD=$S(PSJST="O":PSJPAD,1:PSGODT):0 S PSGFD=$O(^PS(55,DFN,5,"AU",PSJST,PSGFD)) Q:'PSGFD D
+10 FOR PSJST="C","O","OC","P","R"
FOR PSGFD=PSGODT:0
SET PSGFD=$ORDER(^PS(55,DFN,5,"AU",PSJST,PSGFD))
if 'PSGFD
QUIT
Begin DoDot:2
+11 FOR PSGORD=0:0
SET PSGORD=$ORDER(^PS(55,DFN,5,"AU",PSJST,PSGFD,PSGORD))
if 'PSGORD
QUIT
Begin DoDot:3
+12 SET X=$GET(^PS(55,DFN,5,PSGORD,4))
if X]""
SET $PIECE(X,U,9,10)=+$PIECE(X,U,9)_U_+$PIECE(X,U,10)
SET ^(4)=X
+13 if '$PIECE(X,U,9)
SET ^PS(55,"APV",DFN,PSGORD)=""
if '$PIECE(X,U,10)
SET ^PS(55,"ANV",DFN,PSGORD)=""
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
MAILPVNV ;Send mail msg. when UNIT DOSE VERIFICATION DATA has completed.
+1 KILL XMY,PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="Update of Unit Dose Verification Fields"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+2 SET PSG(1,0)="The update of the PV FLAG and NV FLAG fields in the PHARMACY PATIENT"
SET PSG(2,0)="file (#55) has completed."
+3 NEW DIFROM
DO ^XMD
+4 KILL PSG,XMY,XMSUB,XMDUZ,XMTEXT,^XTMP("PSJPVNV")
+5 DO NOW^%DTC
SET $PIECE(^PS(59.7,1,20.5),U)=%
+6 QUIT
