PSSLDALL ;BIR/RTR-Find all Local Possible Dosage to edit ;05/04/08
;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
;
;Reference to 50.607 supported by DBIA 2221
EN ;
W !!,"This option will find all Local Possible Dosages that are eligible for Dosage"
W !,"Checks that do not have either the Numeric Dosage or Dose Unit entered for the"
W !,"Local Possible Dosage. This mapping is necessary to perform Dosage checks."
W !!,"Searching for local Possible Dosages..."
N DIRUT,DIROUT,DIC,DTOUT,DUOUT,X,Y,DIE,DA,DR,PSSGVNMX,PSSGVIEN,PSSGVTOT,PSSGVLPX,PSSGVLC1,PSSGVLC2,PSSGVOUT,PSSGVZR,PSSGVND1,PSSGVND3
N PSSGVOK,PSSGVNDF,PSSGVDF,PSSGVSTN,PSSGVUNT,PSSGVUNX,PSSGVSXX,PSSGVSZZ,PSSGVFLG,PSSGVGG1,PSSGVGG2,PSSGVGG3,PSSGVGG4,PSSGVCNT,PSSGVLP
N PSSGVLOC,PSSGVGG5,PSSGVGG6,PSSGVLCX,PSSGVBF6,PSSGVAF6,DIR,DIDEL
K PSSGVNMX,PSSGVIEN,PSSGVTOT,PSSGVOUT
S (PSSGVOUT,PSSGVTOT)=0
S PSSGVNMX="" F S PSSGVNMX=$O(^PSDRUG("B",PSSGVNMX)) Q:PSSGVNMX=""!(PSSGVOUT) F PSSGVIEN=0:0 S PSSGVIEN=$O(^PSDRUG("B",PSSGVNMX,PSSGVIEN)) Q:'PSSGVIEN!(PSSGVOUT) D
.K PSSGVZR,PSSGVND1,PSSGVND3,PSSGVOK,PSSGVNDF,PSSGVDF,PSSGVLC2,PSSGVLPX,PSSGVLC1,PSSGVSTN,PSSGVUNT,PSSGVUNX,PSSGVSXX,PSSGVSZZ,PSSGVFLG
.K PSSGVGG1,PSSGVGG2,PSSGVGG3,PSSGVGG4,PSSGVCNT,PSSGVLP,PSSGVLOC,PSSGVGG5,PSSGVGG6,PSSGVLCX,PSSGVBF6,PSSGVAF6
.S PSSGVZR=$G(^PSDRUG(PSSGVIEN,0)),PSSGVND1=$P($G(^PSDRUG(PSSGVIEN,"ND")),"^"),PSSGVND3=$P($G(^PSDRUG(PSSGVIEN,"ND")),"^",3)
.S PSSGVTOT=PSSGVTOT+1 I '(PSSGVTOT#20) W "."
.S PSSGVOK=$$TEST
.Q:'PSSGVOK
.S PSSGVLC2=0 F PSSGVLPX=0:0 S PSSGVLPX=$O(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX)) Q:'PSSGVLPX!(PSSGVLC2) S PSSGVLC1=$G(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX,0)) I $P(PSSGVLC1,"^")'="" I '$P(PSSGVLC1,"^",5)!($P(PSSGVLC1,"^",6)="") S PSSGVLC2=1
.Q:'PSSGVLC2
.W !!!?5,"Drug: "_$P(PSSGVZR,"^")
.S PSSGVSTN=$P($G(^PSDRUG(PSSGVIEN,"DOS")),"^"),PSSGVUNT=$P($G(^PSDRUG(PSSGVIEN,"DOS")),"^",2)
.S PSSGVUNX=$S($G(PSSGVUNT):$P($G(^PS(50.607,+$G(PSSGVUNT),0)),"^"),$P($G(PSSGVNDF),"^",6)'="":$P($G(PSSGVNDF),"^",6),1:"")
.L +^PSDRUG(PSSGVIEN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T W !!,"Another person is editing "_$P(PSSGVZR,"^"),! D Q
..K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSSGVOUT=1
.I PSSGVND1,PSSGVND3 S PSSGVSXX=$P(PSSGVNDF,"^",4),PSSGVSZZ=$P(PSSGVNDF,"^",6)
.I PSSGVSTN'="",$E($G(PSSGVSTN),1)="." S PSSGVSTN="0"_PSSGVSTN
.I $G(PSSGVSXX)'="",$E($G(PSSGVSXX),1)="." S PSSGVSXX="0"_PSSGVSXX
.S PSSGVFLG=0
.I $G(PSSGVSXX)'="",($G(PSSGVSTN)'="") I $G(PSSGVSXX)'=$G(PSSGVSTN) D
..S PSSGVFLG=1
..S PSSGVGG1=$L($G(PSSGVSXX)),PSSGVGG2=$L($G(PSSGVUNX)),PSSGVGG3=$L($G(PSSGVSTN)),PSSGVGG4=$L($S($G(PSSGVUNX)'["/":$G(PSSGVUNX),1:""))
..W !!,"Strength from National Drug File match => " D
...I PSSGVGG1+PSSGVGG2<34 W $G(PSSGVSXX)_" "_$G(PSSGVUNX) Q
...W !?3,$G(PSSGVSXX) D
....I PSSGVGG1+PSSGVGG2<73 W " "_$G(PSSGVUNX) Q
....W !?3,$G(PSSGVUNX)
..W !,"Strength currently in the Drug File => " D
...I PSSGVGG3+PSSGVGG4<34 W $G(PSSGVSTN)_" "_$S($G(PSSGVUNX)'["/":$G(PSSGVUNX),1:"") Q
...W !?3,$G(PSSGVSTN) D
....I PSSGVGG3+PSSGVGG4<73 W " "_$S($G(PSSGVUNX)'["/":$G(PSSGVUNX),1:"") Q
....W !?3,$S($G(PSSGVUNX)'["/":$G(PSSGVUNX),1:"")
..W !!,"Please Note: Strength of drug does not match strength of VA Product it is",!,"matched to."
.S PSSGVCNT=0
.F PSSGVLP=0:0 S PSSGVLP=$O(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLP)) Q:'PSSGVLP!(PSSGVOUT) S PSSGVLOC=$G(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLP,0)) D:$P(PSSGVLOC,"^")'=""
..I $P(PSSGVLOC,"^",5),($P(PSSGVLOC,"^",6)'="") Q
..I 'PSSGVCNT,'PSSGVFLG I $G(PSSGVSXX)'=""!($G(PSSGVSTN)'="")!($G(PSSGVUNX)'="") D
...S PSSGVGG5=$L($S($G(PSSGVSTN)'="":$G(PSSGVSTN),$G(PSSGVSXX)'="":$G(PSSGVSXX),1:"")),PSSGVGG6=$L($G(PSSGVUNX))
...W !!,"Strength: "_$S($G(PSSGVSTN)'="":$G(PSSGVSTN),$G(PSSGVSXX)'="":$G(PSSGVSXX),1:"")
...I PSSGVGG5+PSSGVGG6<60 W " Unit: "_$G(PSSGVUNX) Q
...W !,"Unit: "_$G(PSSGVUNX)
..S PSSGVCNT=1
..W !!!,$P(PSSGVLOC,"^") I $P(PSSGVLOC,"^",5)!($P(PSSGVLOC,"^",6)'="") D
...W !,"Numeric Dose: "_$S($E($P(PSSGVLOC,"^",6),1)=".":"0"_$P(PSSGVLOC,"^",6),1:$P(PSSGVLOC,"^",6))
...W ?37,"Dose Unit: "_$S('$P(PSSGVLOC,"^",5):"",1:$P($G(^PS(51.24,+$P(PSSGVLOC,"^",5),0)),"^"))
..W ! K DIE,Y,DTOUT,DR,DA,DIDEL S DA(1)=PSSGVIEN,DIE="^PSDRUG("_PSSGVIEN_",""DOS2"",",DR="4;5",DA=PSSGVLP
..D ^DIE K DIE,DR,DA I $D(DTOUT)!($D(Y)) D Q:PSSGVOUT
...W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue mapping Local Possible Dosages",DIR("B")="Y",DIR("?")="Enter 'Y' to continue mapping Local Possible Dosages, enter 'N' to exit."
...D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!($G(Y)<1) S PSSGVOUT=1
..S PSSGVLCX=$G(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLP,0))
..S PSSGVBF6=$S($E($P(PSSGVLOC,"^",6),1)=".":"0"_$P(PSSGVLOC,"^",6),1:$P(PSSGVLOC,"^",6)) S PSSGVAF6=$S($E($P(PSSGVLCX,"^",6),1)=".":"0"_$P(PSSGVLCX,"^",6),1:$P(PSSGVLCX,"^",6))
..I $P(PSSGVLCX,"^",5)'=$P(PSSGVLOC,"^",5)!(PSSGVBF6'=PSSGVAF6) D
...W !!,$P(PSSGVLCX,"^")
...W !,"Numeric Dose: "_$S($E($P(PSSGVLCX,"^",6),1)=".":"0"_$P(PSSGVLCX,"^",6),1:$P(PSSGVLCX,"^",6))
...W ?40,"Dose Unit: "_$S('$P(PSSGVLCX,"^",5):"",1:$P($G(^PS(51.24,+$P(PSSGVLCX,"^",5),0)),"^"))
.W ! D UL
K PSSGVOUT,PSSGVTOT,PSSGVNMX,PSSGVIEN,PSSGVZR,PSSGVND1,PSSGVND3,PSSGVOK,PSSGVLC2,PSSGVLPX,PSSGVLC1
S (PSSGVOUT,PSSGVTOT)=0 W !!,"Checking for any remaining unmapped Local Possible Dosages..."
S PSSGVNMX="" F S PSSGVNMX=$O(^PSDRUG("B",PSSGVNMX)) Q:PSSGVNMX=""!(PSSGVOUT) F PSSGVIEN=0:0 S PSSGVIEN=$O(^PSDRUG("B",PSSGVNMX,PSSGVIEN)) Q:'PSSGVIEN!(PSSGVOUT) D
.S PSSGVZR=$G(^PSDRUG(PSSGVIEN,0)),PSSGVND1=$P($G(^PSDRUG(PSSGVIEN,"ND")),"^"),PSSGVND3=$P($G(^PSDRUG(PSSGVIEN,"ND")),"^",3)
.S PSSGVTOT=PSSGVTOT+1 I '(PSSGVTOT#100) W "."
.K PSSGVDF,PSSGVNDF S PSSGVOK=$$TEST
.Q:'PSSGVOK
.S PSSGVLC2=0 F PSSGVLPX=0:0 S PSSGVLPX=$O(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX)) Q:'PSSGVLPX!(PSSGVLC2) S PSSGVLC1=$G(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX,0)) I $P(PSSGVLC1,"^")'="" I '$P(PSSGVLC1,"^",5)!($P(PSSGVLC1,"^",6)="") S PSSGVLC2=1
.Q:'PSSGVLC2
.S PSSGVOUT=1
I 'PSSGVOUT W !!,"All Local Possible Dosages are mapped!",! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR Q
W !!,"There are still Local Possible Dosages not yet mapped,",!,"see the 'Local Possible Dosages Report' option for more details.",!
K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
Q
;
UL ;unlock drug
L -^PSDRUG(PSSGVIEN)
Q
;
TEST() ;See if drug need Dose Unit and Numeric Dose defined
I 'PSSGVND3!('PSSGVND1) Q 0
I $P($G(^PSDRUG(PSSGVIEN,"I")),"^"),$P($G(^PSDRUG(PSSGVIEN,"I")),"^")<DT Q 0
N PSSGVDOV
S PSSGVDOV=""
I PSSGVND1,PSSGVND3,$T(OVRIDE^PSNAPIS)]"" S PSSGVDOV=$$OVRIDE^PSNAPIS(PSSGVND1,PSSGVND3)
I '$O(^PSDRUG(PSSGVIEN,"DOS2",0)) Q 0
I $P(PSSGVZR,"^",3)["S"!($E($P(PSSGVZR,"^",2),1,2)="XA") Q 0
I PSSGVND1,PSSGVND3 S PSSGVNDF=$$DFSU^PSNAPIS(PSSGVND1,PSSGVND3) S PSSGVDF=$P(PSSGVNDF,"^")
I $G(PSSGVDF)'>0,$P($G(^PSDRUG(PSSGVIEN,2)),"^") S PSSGVDF=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSGVIEN,2)),"^"),0)),"^",2)
I PSSGVDOV=""!('$G(PSSGVDF))!($P($G(^PS(50.606,+$G(PSSGVDF),1)),"^")="") Q 1
I $P($G(^PS(50.606,+$G(PSSGVDF),1)),"^"),'PSSGVDOV Q 0
I '$P($G(^PS(50.606,+$G(PSSGVDF),1)),"^"),PSSGVDOV Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSLDALL 7278 printed Sep 23, 2025@20:08:36 Page 2
PSSLDALL ;BIR/RTR-Find all Local Possible Dosage to edit ;05/04/08
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
+2 ;
+3 ;Reference to 50.607 supported by DBIA 2221
EN ;
+1 WRITE !!,"This option will find all Local Possible Dosages that are eligible for Dosage"
+2 WRITE !,"Checks that do not have either the Numeric Dosage or Dose Unit entered for the"
+3 WRITE !,"Local Possible Dosage. This mapping is necessary to perform Dosage checks."
+4 WRITE !!,"Searching for local Possible Dosages..."
+5 NEW DIRUT,DIROUT,DIC,DTOUT,DUOUT,X,Y,DIE,DA,DR,PSSGVNMX,PSSGVIEN,PSSGVTOT,PSSGVLPX,PSSGVLC1,PSSGVLC2,PSSGVOUT,PSSGVZR,PSSGVND1,PSSGVND3
+6 NEW PSSGVOK,PSSGVNDF,PSSGVDF,PSSGVSTN,PSSGVUNT,PSSGVUNX,PSSGVSXX,PSSGVSZZ,PSSGVFLG,PSSGVGG1,PSSGVGG2,PSSGVGG3,PSSGVGG4,PSSGVCNT,PSSGVLP
+7 NEW PSSGVLOC,PSSGVGG5,PSSGVGG6,PSSGVLCX,PSSGVBF6,PSSGVAF6,DIR,DIDEL
+8 KILL PSSGVNMX,PSSGVIEN,PSSGVTOT,PSSGVOUT
+9 SET (PSSGVOUT,PSSGVTOT)=0
+10 SET PSSGVNMX=""
FOR
SET PSSGVNMX=$ORDER(^PSDRUG("B",PSSGVNMX))
if PSSGVNMX=""!(PSSGVOUT)
QUIT
FOR PSSGVIEN=0:0
SET PSSGVIEN=$ORDER(^PSDRUG("B",PSSGVNMX,PSSGVIEN))
if 'PSSGVIEN!(PSSGVOUT)
QUIT
Begin DoDot:1
+11 KILL PSSGVZR,PSSGVND1,PSSGVND3,PSSGVOK,PSSGVNDF,PSSGVDF,PSSGVLC2,PSSGVLPX,PSSGVLC1,PSSGVSTN,PSSGVUNT,PSSGVUNX,PSSGVSXX,PSSGVSZZ,PSSGVFLG
+12 KILL PSSGVGG1,PSSGVGG2,PSSGVGG3,PSSGVGG4,PSSGVCNT,PSSGVLP,PSSGVLOC,PSSGVGG5,PSSGVGG6,PSSGVLCX,PSSGVBF6,PSSGVAF6
+13 SET PSSGVZR=$GET(^PSDRUG(PSSGVIEN,0))
SET PSSGVND1=$PIECE($GET(^PSDRUG(PSSGVIEN,"ND")),"^")
SET PSSGVND3=$PIECE($GET(^PSDRUG(PSSGVIEN,"ND")),"^",3)
+14 SET PSSGVTOT=PSSGVTOT+1
IF '(PSSGVTOT#20)
WRITE "."
+15 SET PSSGVOK=$$TEST
+16 if 'PSSGVOK
QUIT
+17 SET PSSGVLC2=0
FOR PSSGVLPX=0:0
SET PSSGVLPX=$ORDER(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX))
if 'PSSGVLPX!(PSSGVLC2)
QUIT
SET PSSGVLC1=$GET(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX,0))
IF $PIECE(PSSGVLC1,"^")'=""
IF '$PIECE(PSSGVLC1,"^",5)!($PIECE(PSSGVLC1,"^",6)="")
SET PSSGVLC2=1
+18 if 'PSSGVLC2
QUIT
+19 WRITE !!!?5,"Drug: "_$PIECE(PSSGVZR,"^")
+20 SET PSSGVSTN=$PIECE($GET(^PSDRUG(PSSGVIEN,"DOS")),"^")
SET PSSGVUNT=$PIECE($GET(^PSDRUG(PSSGVIEN,"DOS")),"^",2)
+21 SET PSSGVUNX=$SELECT($GET(PSSGVUNT):$PIECE($GET(^PS(50.607,+$GET(PSSGVUNT),0)),"^"),$PIECE($GET(PSSGVNDF),"^",6)'="":$PIECE($GET(PSSGVNDF),"^",6),1:"")
+22 LOCK +^PSDRUG(PSSGVIEN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
WRITE !!,"Another person is editing "_$PIECE(PSSGVZR,"^"),!
Begin DoDot:2
+23 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSSGVOUT=1
End DoDot:2
QUIT
+24 IF PSSGVND1
IF PSSGVND3
SET PSSGVSXX=$PIECE(PSSGVNDF,"^",4)
SET PSSGVSZZ=$PIECE(PSSGVNDF,"^",6)
+25 IF PSSGVSTN'=""
IF $EXTRACT($GET(PSSGVSTN),1)="."
SET PSSGVSTN="0"_PSSGVSTN
+26 IF $GET(PSSGVSXX)'=""
IF $EXTRACT($GET(PSSGVSXX),1)="."
SET PSSGVSXX="0"_PSSGVSXX
+27 SET PSSGVFLG=0
+28 IF $GET(PSSGVSXX)'=""
IF ($GET(PSSGVSTN)'="")
IF $GET(PSSGVSXX)'=$GET(PSSGVSTN)
Begin DoDot:2
+29 SET PSSGVFLG=1
+30 SET PSSGVGG1=$LENGTH($GET(PSSGVSXX))
SET PSSGVGG2=$LENGTH($GET(PSSGVUNX))
SET PSSGVGG3=$LENGTH($GET(PSSGVSTN))
SET PSSGVGG4=$LENGTH($SELECT($GET(PSSGVUNX)'["/":$GET(PSSGVUNX),1:""))
+31 WRITE !!,"Strength from National Drug File match => "
Begin DoDot:3
+32 IF PSSGVGG1+PSSGVGG2<34
WRITE $GET(PSSGVSXX)_" "_$GET(PSSGVUNX)
QUIT
+33 WRITE !?3,$GET(PSSGVSXX)
Begin DoDot:4
+34 IF PSSGVGG1+PSSGVGG2<73
WRITE " "_$GET(PSSGVUNX)
QUIT
+35 WRITE !?3,$GET(PSSGVUNX)
End DoDot:4
End DoDot:3
+36 WRITE !,"Strength currently in the Drug File => "
Begin DoDot:3
+37 IF PSSGVGG3+PSSGVGG4<34
WRITE $GET(PSSGVSTN)_" "_$SELECT($GET(PSSGVUNX)'["/":$GET(PSSGVUNX),1:"")
QUIT
+38 WRITE !?3,$GET(PSSGVSTN)
Begin DoDot:4
+39 IF PSSGVGG3+PSSGVGG4<73
WRITE " "_$SELECT($GET(PSSGVUNX)'["/":$GET(PSSGVUNX),1:"")
QUIT
+40 WRITE !?3,$SELECT($GET(PSSGVUNX)'["/":$GET(PSSGVUNX),1:"")
End DoDot:4
End DoDot:3
+41 WRITE !!,"Please Note: Strength of drug does not match strength of VA Product it is",!,"matched to."
End DoDot:2
+42 SET PSSGVCNT=0
+43 FOR PSSGVLP=0:0
SET PSSGVLP=$ORDER(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLP))
if 'PSSGVLP!(PSSGVOUT)
QUIT
SET PSSGVLOC=$GET(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLP,0))
if $PIECE(PSSGVLOC,"^")'=""
Begin DoDot:2
+44 IF $PIECE(PSSGVLOC,"^",5)
IF ($PIECE(PSSGVLOC,"^",6)'="")
QUIT
+45 IF 'PSSGVCNT
IF 'PSSGVFLG
IF $GET(PSSGVSXX)'=""!($GET(PSSGVSTN)'="")!($GET(PSSGVUNX)'="")
Begin DoDot:3
+46 SET PSSGVGG5=$LENGTH($SELECT($GET(PSSGVSTN)'="":$GET(PSSGVSTN),$GET(PSSGVSXX)'="":$GET(PSSGVSXX),1:""))
SET PSSGVGG6=$LENGTH($GET(PSSGVUNX))
+47 WRITE !!,"Strength: "_$SELECT($GET(PSSGVSTN)'="":$GET(PSSGVSTN),$GET(PSSGVSXX)'="":$GET(PSSGVSXX),1:"")
+48 IF PSSGVGG5+PSSGVGG6<60
WRITE " Unit: "_$GET(PSSGVUNX)
QUIT
+49 WRITE !,"Unit: "_$GET(PSSGVUNX)
End DoDot:3
+50 SET PSSGVCNT=1
+51 WRITE !!!,$PIECE(PSSGVLOC,"^")
IF $PIECE(PSSGVLOC,"^",5)!($PIECE(PSSGVLOC,"^",6)'="")
Begin DoDot:3
+52 WRITE !,"Numeric Dose: "_$SELECT($EXTRACT($PIECE(PSSGVLOC,"^",6),1)=".":"0"_$PIECE(PSSGVLOC,"^",6),1:$PIECE(PSSGVLOC,"^",6))
+53 WRITE ?37,"Dose Unit: "_$SELECT('$PIECE(PSSGVLOC,"^",5):"",1:$PIECE($GET(^PS(51.24,+$PIECE(PSSGVLOC,"^",5),0)),"^"))
End DoDot:3
+54 WRITE !
KILL DIE,Y,DTOUT,DR,DA,DIDEL
SET DA(1)=PSSGVIEN
SET DIE="^PSDRUG("_PSSGVIEN_",""DOS2"","
SET DR="4;5"
SET DA=PSSGVLP
+55 DO ^DIE
KILL DIE,DR,DA
IF $DATA(DTOUT)!($DATA(Y))
Begin DoDot:3
+56 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue mapping Local Possible Dosages"
SET DIR("B")="Y"
SET DIR("?")="Enter 'Y' to continue mapping Local Possible Dosages, enter 'N' to exit."
+57 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(Y)<1)
SET PSSGVOUT=1
End DoDot:3
if PSSGVOUT
QUIT
+58 SET PSSGVLCX=$GET(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLP,0))
+59 SET PSSGVBF6=$SELECT($EXTRACT($PIECE(PSSGVLOC,"^",6),1)=".":"0"_$PIECE(PSSGVLOC,"^",6),1:$PIECE(PSSGVLOC,"^",6))
SET PSSGVAF6=$SELECT($EXTRACT($PIECE(PSSGVLCX,"^",6),1)=".":"0"_$PIECE(PSSGVLCX,"^",6),1:$PIECE(PSSGVLCX,"^",6))
+60 IF $PIECE(PSSGVLCX,"^",5)'=$PIECE(PSSGVLOC,"^",5)!(PSSGVBF6'=PSSGVAF6)
Begin DoDot:3
+61 WRITE !!,$PIECE(PSSGVLCX,"^")
+62 WRITE !,"Numeric Dose: "_$SELECT($EXTRACT($PIECE(PSSGVLCX,"^",6),1)=".":"0"_$PIECE(PSSGVLCX,"^",6),1:$PIECE(PSSGVLCX,"^",6))
+63 WRITE ?40,"Dose Unit: "_$SELECT('$PIECE(PSSGVLCX,"^",5):"",1:$PIECE($GET(^PS(51.24,+$PIECE(PSSGVLCX,"^",5),0)),"^"))
End DoDot:3
End DoDot:2
+64 WRITE !
DO UL
End DoDot:1
+65 KILL PSSGVOUT,PSSGVTOT,PSSGVNMX,PSSGVIEN,PSSGVZR,PSSGVND1,PSSGVND3,PSSGVOK,PSSGVLC2,PSSGVLPX,PSSGVLC1
+66 SET (PSSGVOUT,PSSGVTOT)=0
WRITE !!,"Checking for any remaining unmapped Local Possible Dosages..."
+67 SET PSSGVNMX=""
FOR
SET PSSGVNMX=$ORDER(^PSDRUG("B",PSSGVNMX))
if PSSGVNMX=""!(PSSGVOUT)
QUIT
FOR PSSGVIEN=0:0
SET PSSGVIEN=$ORDER(^PSDRUG("B",PSSGVNMX,PSSGVIEN))
if 'PSSGVIEN!(PSSGVOUT)
QUIT
Begin DoDot:1
+68 SET PSSGVZR=$GET(^PSDRUG(PSSGVIEN,0))
SET PSSGVND1=$PIECE($GET(^PSDRUG(PSSGVIEN,"ND")),"^")
SET PSSGVND3=$PIECE($GET(^PSDRUG(PSSGVIEN,"ND")),"^",3)
+69 SET PSSGVTOT=PSSGVTOT+1
IF '(PSSGVTOT#100)
WRITE "."
+70 KILL PSSGVDF,PSSGVNDF
SET PSSGVOK=$$TEST
+71 if 'PSSGVOK
QUIT
+72 SET PSSGVLC2=0
FOR PSSGVLPX=0:0
SET PSSGVLPX=$ORDER(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX))
if 'PSSGVLPX!(PSSGVLC2)
QUIT
SET PSSGVLC1=$GET(^PSDRUG(PSSGVIEN,"DOS2",PSSGVLPX,0))
IF $PIECE(PSSGVLC1,"^")'=""
IF '$PIECE(PSSGVLC1,"^",5)!($PIECE(PSSGVLC1,"^",6)="")
SET PSSGVLC2=1
+73 if 'PSSGVLC2
QUIT
+74 SET PSSGVOUT=1
End DoDot:1
+75 IF 'PSSGVOUT
WRITE !!,"All Local Possible Dosages are mapped!",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
QUIT
+76 WRITE !!,"There are still Local Possible Dosages not yet mapped,",!,"see the 'Local Possible Dosages Report' option for more details.",!
+77 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
+78 QUIT
+79 ;
UL ;unlock drug
+1 LOCK -^PSDRUG(PSSGVIEN)
+2 QUIT
+3 ;
TEST() ;See if drug need Dose Unit and Numeric Dose defined
+1 IF 'PSSGVND3!('PSSGVND1)
QUIT 0
+2 IF $PIECE($GET(^PSDRUG(PSSGVIEN,"I")),"^")
IF $PIECE($GET(^PSDRUG(PSSGVIEN,"I")),"^")<DT
QUIT 0
+3 NEW PSSGVDOV
+4 SET PSSGVDOV=""
+5 IF PSSGVND1
IF PSSGVND3
IF $TEXT(OVRIDE^PSNAPIS)]""
SET PSSGVDOV=$$OVRIDE^PSNAPIS(PSSGVND1,PSSGVND3)
+6 IF '$ORDER(^PSDRUG(PSSGVIEN,"DOS2",0))
QUIT 0
+7 IF $PIECE(PSSGVZR,"^",3)["S"!($EXTRACT($PIECE(PSSGVZR,"^",2),1,2)="XA")
QUIT 0
+8 IF PSSGVND1
IF PSSGVND3
SET PSSGVNDF=$$DFSU^PSNAPIS(PSSGVND1,PSSGVND3)
SET PSSGVDF=$PIECE(PSSGVNDF,"^")
+9 IF $GET(PSSGVDF)'>0
IF $PIECE($GET(^PSDRUG(PSSGVIEN,2)),"^")
SET PSSGVDF=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSGVIEN,2)),"^"),0)),"^",2)
+10 IF PSSGVDOV=""!('$GET(PSSGVDF))!($PIECE($GET(^PS(50.606,+$GET(PSSGVDF),1)),"^")="")
QUIT 1
+11 IF $PIECE($GET(^PS(50.606,+$GET(PSSGVDF),1)),"^")
IF 'PSSGVDOV
QUIT 0
+12 IF '$PIECE($GET(^PS(50.606,+$GET(PSSGVDF),1)),"^")
IF PSSGVDOV
QUIT 0
+13 QUIT 1
