- 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 Mar 13, 2025@21:37:22 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
