PSSDOSCR ;BIR/RTR-Dosage creation routine ;03/09/00
;;1.0;PHARMACY DATA MANAGEMENT;**34,38**;9/30/97
;Reference to ^PS(50.607 supported by DBIA 2221
;
S PSSTRAC=+$O(^PS(59.7,0))
S PSSCLEAN=0
S PSSTRACK=$P($G(^PS(59.7,PSSTRAC,80)),"^",3)
I PSSTRACK=1 S Y=$P($G(^PS(59.7,PSSTRAC,80)),"^",4) D:Y DD^%DT W !!!,$C(7),"Dosage conversion has already been queued for "_$G(Y),! K PSSTRAC,PSSTRACK,Y Q
I PSSTRACK=2 W !!!,$C(7),"Dosage conversion is currently running, cannot run at this time.",! K PSSTRAC,PSSTRACK Q
W !!,"This option will queue the conversion that populates the Possible Dosages",!,"and Local Possible Dosages in the Drug file. New dosages will be added to",!,"dosages that are already in the file.",!
I PSSTRACK=3 K PSSOUT D I $G(PSSOUT) W !!,"Nothing queued.",! G ENDX
.K PSSSTART,PSSSTOP,PSSWHO S Y=$P($G(^PS(59.7,PSSTRAC,80)),"^",4) D DD^%DT S PSSSTART=Y S Y=$P($G(^PS(59.7,PSSTRAC,80)),"^",5) D DD^%DT S PSSSTOP=Y I $P($G(^PS(59.7,PSSTRAC,80)),"^",6) D WHO
.W !,"The dosage conversion was last run by "_$G(PSSWHO),!,"It started on "_$G(PSSSTART)_" and ended on "_$G(PSSSTOP),!
.K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Are you sure you want to run the Dosage conversion again",DIR("?")=" "
.S DIR("?",1)="If you run the Dosage conversion again, any new Dosages that can be created",DIR("?",2)="will be merged with the Dosages that you have already built in your DRUG file."
.W $C(7) D ^DIR K DIR I Y'=1 S PSSOUT=1 Q
S:$G(PSSTRACK)="" PSSTRACK=0
W ! S PSSDUZ=+$G(DUZ) K ZTDTH S ZTRTN="EN^PSSDOSCR",ZTDESC="DOSAGE CONVERSION",ZTIO="",ZTSAVE("PSSDUZ")="",ZTSAVE("PSSTRAC")="",ZTSAVE("PSSTRACK")="",ZTSAVE("PSSCLEAN")="" D ^%ZTLOAD I $D(ZTSK)[0 W !!,"Nothing queued.",! G ENDX
K %,X I $G(ZTSK("D"))'="" S %H=ZTSK("D") D YX^%DTC K %H
S $P(^PS(59.7,PSSTRAC,80),"^",3)=1,$P(^(80),"^",4)=$G(X)_$G(%),$P(^(80),"^",5)="",$P(^(80),"^",6)=$G(DUZ) K X,%
W !!,"Dosage Conversion queued!",! G ENDX
EN ;
K PSSBOTH,PSSTODOS,PSSD,PSSFLAG,PSSND,PSSNODE,PSSDF,PSSST,PSSUN,PSSFLAGZ,PSI,PSO,PSSTOT,PSSDUPD,PSSTOTX,PSSONLYO,PSSONLYI
S $P(^PS(59.7,PSSTRAC,80),"^",3)=2 D NOW^%DTC S $P(^PS(59.7,PSSTRAC,80),"^",4)=%,$P(^(80),"^",6)=$G(PSSDUZ)
S PSSTRACK=$S($G(PSSTRACK):1,1:0)
I $G(PSSTRACK),'$G(PSSCLEAN) G ^PSSDOSCX
F PZZ=0:0 S PZZ=$O(^PSDRUG(PZZ)) Q:'PZZ K ^PSDRUG(PZZ,"DOS"),^PSDRUG(PZZ,"DOS1"),^PSDRUG(PZZ,"DOS2")
F PSSD=0:0 S PSSD=$O(^PSDRUG(PSSD)) Q:'PSSD D D:'$G(PSSFLAG) LOCAL
.S (PSSFLAG,PSSONLYI,PSSONLYO,PSSBOTH)=0
.S PSSND=$P($G(^PSDRUG(PSSD,"ND")),"^",3),PSSND1=$P($G(^("ND")),"^") Q:'PSSND!('PSSND1)
.S X=$$DFSU^PSNAPIS(PSSND1,PSSND) S PSSDF=$P(X,"^"),PSSST=$P(X,"^",4),PSSUN=$P(X,"^",5) K X
.Q:'PSSDF!('PSSUN)!($G(PSSST)="")
.Q:'$D(^PS(50.606,PSSDF,0))!('$D(^PS(50.607,PSSUN,0)))
.I PSSST'?.N&(PSSST'?.N1".".N) Q
.S (PSSFLAGZ,PSI,PSO)=0 D Q:'$G(PSSFLAGZ)
..I $D(^PS(50.606,"ACONI",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPI",PSSDF,0)) S (PSSFLAGZ,PSI)=1
..I $D(^PS(50.606,"ACONO",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPO",PSSDF,0)) S (PSSFLAGZ,PSO)=1
.;CONVERT POSSIBLE DOSAGES
.I 'PSI,'PSO S PSSBOTH=1 Q
.I PSI,'PSO D S:PSSTOT>1 PSSTOTX=PSSTOT-1,^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN,PSSONLYO=1,^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX) Q
..S PSSTOT=1 F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...S PSSTODOS=PSSDUPD*PSSST
...S ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^I",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
.I PSO,'PSI D S:PSSTOT>1 PSSTOTX=PSSTOT-1,^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN,PSSONLYI=1,^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX) Q
..S PSSTOT=1 F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...S PSSTODOS=PSSDUPD*PSSST
...S ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
.I PSO,PSI D S:PSSTOT>1 PSSTOTX=PSSTOT-1,^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN,PSSFLAG=1,^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX)
..S PSSTOT=1 F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...S PSSTODOS=PSSDUPD*PSSST
...S ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS S $P(^PSDRUG(PSSD,"DOS1",PSSTOT,0),"^",3)=$S($D(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)):"IO",1:"I") S ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
.I PSO,PSI D S:PSSTOT>1 PSSTOTX=PSSTOT-1,^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN,PSSFLAG=1,^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX)
..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...I $D(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q
...S PSSTODOS=PSSDUPD*PSSST
...S ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
END ;
S $P(^PS(59.7,PSSTRAC,80),"^",3)=3 D NOW^%DTC S $P(^PS(59.7,PSSTRAC,80),"^",5)=%
S XMDUZ="PHARMACY DATA MANAGEMENT",XMY(PSSDUZ)="",XMSUB="PDM DOSAGE CONVERSION"
K PSSDTEXT S PSSDTEXT(1)="The PDM Auto Create Dosages Job has run to completion.",PSSDTEXT(2)="Please use the Dosages Review Report to print out results."
S XMTEXT="PSSDTEXT(" D ^XMD K PSSDTEXT,XMDUZ,XMY,XMSUB,XMTEXT
ENDX ;
K %,PSSTODOS,PSSD,PSSBOTH,PSSFLAG,PSSND,PSSND1,PSSDF,PSSST,PSSUN,PSSFLAGZ,PSI,PSO,PSSTOT,PSSDUSP,PSSTOTX,PSSOI,PSSOID,PSDOD,PSNOUN,PSNOUNPA,PSALL,PSNOUNPT,PSSLTOT,PSSLTOTX,PSSTRAC,PSSTRACK,PSSOUT,PSSSTART,PSSSTOP,PSSWHO,PSSONLYO,PSSONLYI
K PSSDUZ,PSSCLEAN S:$D(ZTQUEUED) ZTREQ="@"
Q
LOCAL ;DO LOCAL POSSIBLE DOSES HERE
K PSSOI,PSSOID,PSDOD,PSDUPDPT,PSNOUN,PSNOUNPT,PSNOUNPA,PSALL,PSSLTOT,PSSLTOTX
S PSSOI=$P($G(^PSDRUG(PSSD,2)),"^") Q:'PSSOI
S PSSOID=+$P($G(^PS(50.7,PSSOI,0)),"^",2) Q:'PSSOID
Q:'$O(^PS(50.606,PSSOID,"NOUN",0))
I $O(^PS(50.606,PSSOID,"DUPD",0)) D S:PSSLTOT>1 PSSLTOTX=PSSLTOT-1,^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$G(PSSLTOTX)_"^"_$G(PSSLTOTX) Q
.S PSSLTOT=1
.F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
..Q:PSNOUNPA=""
..F PSDOD=0:0 S PSDOD=$O(^PS(50.606,PSSOID,"DUPD",PSDOD)) Q:'PSDOD S PSDUPDPT=$P($G(^(PSDOD,0)),"^") D:PSDUPDPT'=""
...I $G(PSSONLYO),PSNOUNPA'["O" Q
...I $G(PSSONLYI),PSNOUNPA'["I" Q
...D TEST
...S PSALL=$G(PSDUPDPT)_" "_$S($G(PSSNLF):$G(PSSNLX),1:$G(PSNOUNPT)) K PSSNL,PSSNLF,PSSNLX
...S ^PSDRUG(PSSD,"DOS2",PSSLTOT,0)=$G(PSALL)_"^"_$G(PSNOUNPA),^PSDRUG(PSSD,"DOS2","B",$E(PSALL,1,30),PSSLTOT)="" S PSSLTOT=PSSLTOT+1
S PSSLTOT=1 F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
.Q:PSNOUNPA=""
.I $G(PSSONLYI),PSNOUNPA'["I" Q
.I $G(PSSONLYO),PSNOUNPA'["O" Q
.S ^PSDRUG(PSSD,"DOS2",PSSLTOT,0)=PSNOUNPT_"^"_$G(PSNOUNPA),^PSDRUG(PSSD,"DOS2","B",$E(PSNOUNPT,1,30),PSSLTOT)="" S PSSLTOT=PSSLTOT+1
I PSSLTOT>1 S PSSLTOTX=PSSLTOT-1 S ^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$G(PSSLTOTX)_"^"_$G(PSSLTOTX)
Q
WHO ;
K PSSWHOAR S DA=+$P($G(^PS(59.7,PSSTRAC,80)),"^",6),DIC=200,DR=".01",DIQ(0)="E",DIQ="PSSWHOAR" D EN^DIQ1 S PSSWHO=$G(PSSWHOAR(200,DA,.01,"E")) K DIQ,PSSWHOAR,DR,DA,DIC
Q
TEST ;
K PSSNL,PSSNLF,PSSNLX
Q:$G(PSNOUNPT)=""
Q:$L(PSNOUNPT)'>3
S PSSNL=$E(PSNOUNPT,($L(PSNOUNPT)-2),$L(PSNOUNPT))
I $G(PSSNL)="(S)"!($G(PSSNL)="(s)") S PSSNLF=1 D
.I $G(PSDUPDPT)'>1 S PSSNLX=$E(PSNOUNPT,1,($L(PSNOUNPT)-3))
.I $G(PSDUPDPT)>1 S PSSNLX=$E(PSNOUNPT,1,($L(PSNOUNPT)-3))_$E(PSSNL,2)
Q
PSSDOSCR ;BIR/RTR-Dosage creation routine ;03/09/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**34,38**;9/30/97
+2 ;Reference to ^PS(50.607 supported by DBIA 2221
+3 ;
+4 SET PSSTRAC=+$ORDER(^PS(59.7,0))
+5 SET PSSCLEAN=0
+6 SET PSSTRACK=$PIECE($GET(^PS(59.7,PSSTRAC,80)),"^",3)
+7 IF PSSTRACK=1
SET Y=$PIECE($GET(^PS(59.7,PSSTRAC,80)),"^",4)
IF Y
DO DD^%DT
WRITE !!!,$CHAR(7),"Dosage conversion has already been queued for "_$GET(Y),!
KILL PSSTRAC,PSSTRACK,Y
QUIT
+8 IF PSSTRACK=2
WRITE !!!,$CHAR(7),"Dosage conversion is currently running, cannot run at this time.",!
KILL PSSTRAC,PSSTRACK
QUIT
+9 WRITE !!,"This option will queue the conversion that populates the Possible Dosages",!,"and Local Possible Dosages in the Drug file. New dosages will be added to",!,"dosages that are already in the file.",!
+10 IF PSSTRACK=3
KILL PSSOUT
Begin DoDot:1
+11 KILL PSSSTART,PSSSTOP,PSSWHO
SET Y=$PIECE($GET(^PS(59.7,PSSTRAC,80)),"^",4)
DO DD^%DT
SET PSSSTART=Y
SET Y=$PIECE($GET(^PS(59.7,PSSTRAC,80)),"^",5)
DO DD^%DT
SET PSSSTOP=Y
IF $PIECE($GET(^PS(59.7,PSSTRAC,80)),"^",6)
DO WHO
+12 WRITE !,"The dosage conversion was last run by "_$GET(PSSWHO),!,"It started on "_$GET(PSSSTART)_" and ended on "_$GET(PSSSTOP),!
+13 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Are you sure you want to run the Dosage conversion again"
SET DIR("?")=" "
+14 SET DIR("?",1)="If you run the Dosage conversion again, any new Dosages that can be created"
SET DIR("?",2)="will be merged with the Dosages that you have already built in your DRUG file."
+15 WRITE $CHAR(7)
DO ^DIR
KILL DIR
IF Y'=1
SET PSSOUT=1
QUIT
End DoDot:1
IF $GET(PSSOUT)
WRITE !!,"Nothing queued.",!
GOTO ENDX
+16 IF $GET(PSSTRACK)=""
SET PSSTRACK=0
+17 WRITE !
SET PSSDUZ=+$GET(DUZ)
KILL ZTDTH
SET ZTRTN="EN^PSSDOSCR"
SET ZTDESC="DOSAGE CONVERSION"
SET ZTIO=""
SET ZTSAVE("PSSDUZ")=""
SET ZTSAVE("PSSTRAC")=""
SET ZTSAVE("PSSTRACK")=""
SET ZTSAVE("PSSCLEAN")=""
DO ^%ZTLOAD
IF $DATA(ZTSK)[0
WRITE !!,"Nothing queued.",!
GOTO ENDX
+18 KILL %,X
IF $GET(ZTSK("D"))'=""
SET %H=ZTSK("D")
DO YX^%DTC
KILL %H
+19 SET $PIECE(^PS(59.7,PSSTRAC,80),"^",3)=1
SET $PIECE(^(80),"^",4)=$GET(X)_$GET(%)
SET $PIECE(^(80),"^",5)=""
SET $PIECE(^(80),"^",6)=$GET(DUZ)
KILL X,%
+20 WRITE !!,"Dosage Conversion queued!",!
GOTO ENDX
EN ;
+1 KILL PSSBOTH,PSSTODOS,PSSD,PSSFLAG,PSSND,PSSNODE,PSSDF,PSSST,PSSUN,PSSFLAGZ,PSI,PSO,PSSTOT,PSSDUPD,PSSTOTX,PSSONLYO,PSSONLYI
+2 SET $PIECE(^PS(59.7,PSSTRAC,80),"^",3)=2
DO NOW^%DTC
SET $PIECE(^PS(59.7,PSSTRAC,80),"^",4)=%
SET $PIECE(^(80),"^",6)=$GET(PSSDUZ)
+3 SET PSSTRACK=$SELECT($GET(PSSTRACK):1,1:0)
+4 IF $GET(PSSTRACK)
IF '$GET(PSSCLEAN)
GOTO ^PSSDOSCX
+5 FOR PZZ=0:0
SET PZZ=$ORDER(^PSDRUG(PZZ))
IF 'PZZ
QUIT
KILL ^PSDRUG(PZZ,"DOS"),^PSDRUG(PZZ,"DOS1"),^PSDRUG(PZZ,"DOS2")
+6 FOR PSSD=0:0
SET PSSD=$ORDER(^PSDRUG(PSSD))
IF 'PSSD
QUIT
Begin DoDot:1
+7 SET (PSSFLAG,PSSONLYI,PSSONLYO,PSSBOTH)=0
+8 SET PSSND=$PIECE($GET(^PSDRUG(PSSD,"ND")),"^",3)
SET PSSND1=$PIECE($GET(^("ND")),"^")
IF 'PSSND!('PSSND1)
QUIT
+9 SET X=$$DFSU^PSNAPIS(PSSND1,PSSND)
SET PSSDF=$PIECE(X,"^")
SET PSSST=$PIECE(X,"^",4)
SET PSSUN=$PIECE(X,"^",5)
KILL X
+10 IF 'PSSDF!('PSSUN)!($GET(PSSST)="")
QUIT
+11 IF '$DATA(^PS(50.606,PSSDF,0))!('$DATA(^PS(50.607,PSSUN,0)))
QUIT
+12 IF PSSST'?.N&(PSSST'?.N1".".N)
QUIT
+13 SET (PSSFLAGZ,PSI,PSO)=0
Begin DoDot:2
+14 IF $DATA(^PS(50.606,"ACONI",PSSDF,PSSUN))
IF $ORDER(^PS(50.606,"ADUPI",PSSDF,0))
SET (PSSFLAGZ,PSI)=1
+15 IF $DATA(^PS(50.606,"ACONO",PSSDF,PSSUN))
IF $ORDER(^PS(50.606,"ADUPO",PSSDF,0))
SET (PSSFLAGZ,PSO)=1
End DoDot:2
IF '$GET(PSSFLAGZ)
QUIT
+16 ;CONVERT POSSIBLE DOSAGES
+17 IF 'PSI
IF 'PSO
SET PSSBOTH=1
QUIT
+18 IF PSI
IF 'PSO
Begin DoDot:2
+19 SET PSSTOT=1
FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+20 SET PSSTODOS=PSSDUPD*PSSST
+21 SET ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^I"
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)=""
SET PSSTOT=PSSTOT+1
End DoDot:3
End DoDot:2
IF PSSTOT>1
SET PSSTOTX=PSSTOT-1
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
SET PSSONLYO=1
SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSTOTX)_"^"_$GET(PSSTOTX)
QUIT
+22 IF PSO
IF 'PSI
Begin DoDot:2
+23 SET PSSTOT=1
FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPO",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+24 SET PSSTODOS=PSSDUPD*PSSST
+25 SET ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^O"
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)=""
SET PSSTOT=PSSTOT+1
End DoDot:3
End DoDot:2
IF PSSTOT>1
SET PSSTOTX=PSSTOT-1
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
SET PSSONLYI=1
SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSTOTX)_"^"_$GET(PSSTOTX)
QUIT
+26 IF PSO
IF PSI
Begin DoDot:2
+27 SET PSSTOT=1
FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+28 SET PSSTODOS=PSSDUPD*PSSST
+29 SET ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS
SET $PIECE(^PSDRUG(PSSD,"DOS1",PSSTOT,0),"^",3)=$SELECT($DATA(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)):"IO",1:"I")
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)=""
SET PSSTOT=PSSTOT+1
End DoDot:3
End DoDot:2
IF PSSTOT>1
SET PSSTOTX=PSSTOT-1
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
SET PSSFLAG=1
SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSTOTX)_"^"_$GET(PSSTOTX)
+30 IF PSO
IF PSI
Begin DoDot:2
+31 FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPO",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+32 IF $DATA(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
QUIT
+33 SET PSSTODOS=PSSDUPD*PSSST
+34 SET ^PSDRUG(PSSD,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^O"
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSTOT)=""
SET PSSTOT=PSSTOT+1
End DoDot:3
End DoDot:2
IF PSSTOT>1
SET PSSTOTX=PSSTOT-1
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
SET PSSFLAG=1
SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSTOTX)_"^"_$GET(PSSTOTX)
End DoDot:1
IF '$GET(PSSFLAG)
DO LOCAL
END ;
+1 SET $PIECE(^PS(59.7,PSSTRAC,80),"^",3)=3
DO NOW^%DTC
SET $PIECE(^PS(59.7,PSSTRAC,80),"^",5)=%
+2 SET XMDUZ="PHARMACY DATA MANAGEMENT"
SET XMY(PSSDUZ)=""
SET XMSUB="PDM DOSAGE CONVERSION"
+3 KILL PSSDTEXT
SET PSSDTEXT(1)="The PDM Auto Create Dosages Job has run to completion."
SET PSSDTEXT(2)="Please use the Dosages Review Report to print out results."
+4 SET XMTEXT="PSSDTEXT("
DO ^XMD
KILL PSSDTEXT,XMDUZ,XMY,XMSUB,XMTEXT
ENDX ;
+1 KILL %,PSSTODOS,PSSD,PSSBOTH,PSSFLAG,PSSND,PSSND1,PSSDF,PSSST,PSSUN,PSSFLAGZ,PSI,PSO,PSSTOT,PSSDUSP,PSSTOTX,PSSOI,PSSOID,PSDOD,PSNOUN,PSNOUNPA,PSALL,PSNOUNPT,PSSLTOT,PSSLTOTX,PSSTRAC,PSSTRACK,PSSOUT,PSSSTART,PSSSTOP,PSSWHO,PSSONLYO,PSSONLYI
+2 KILL PSSDUZ,PSSCLEAN
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
LOCAL ;DO LOCAL POSSIBLE DOSES HERE
+1 KILL PSSOI,PSSOID,PSDOD,PSDUPDPT,PSNOUN,PSNOUNPT,PSNOUNPA,PSALL,PSSLTOT,PSSLTOTX
+2 SET PSSOI=$PIECE($GET(^PSDRUG(PSSD,2)),"^")
IF 'PSSOI
QUIT
+3 SET PSSOID=+$PIECE($GET(^PS(50.7,PSSOI,0)),"^",2)
IF 'PSSOID
QUIT
+4 IF '$ORDER(^PS(50.606,PSSOID,"NOUN",0))
QUIT
+5 IF $ORDER(^PS(50.606,PSSOID,"DUPD",0))
Begin DoDot:1
+6 SET PSSLTOT=1
+7 FOR PSNOUN=0:0
SET PSNOUN=$ORDER(^PS(50.606,PSSOID,"NOUN",PSNOUN))
IF 'PSNOUN
QUIT
SET PSNOUNPT=$PIECE($GET(^(PSNOUN,0)),"^")
SET PSNOUNPA=$PIECE($GET(^(0)),"^",2)
IF PSNOUNPT'=""
Begin DoDot:2
+8 IF PSNOUNPA=""
QUIT
+9 FOR PSDOD=0:0
SET PSDOD=$ORDER(^PS(50.606,PSSOID,"DUPD",PSDOD))
IF 'PSDOD
QUIT
SET PSDUPDPT=$PIECE($GET(^(PSDOD,0)),"^")
IF PSDUPDPT'=""
Begin DoDot:3
+10 IF $GET(PSSONLYO)
IF PSNOUNPA'["O"
QUIT
+11 IF $GET(PSSONLYI)
IF PSNOUNPA'["I"
QUIT
+12 DO TEST
+13 SET PSALL=$GET(PSDUPDPT)_" "_$SELECT($GET(PSSNLF):$GET(PSSNLX),1:$GET(PSNOUNPT))
KILL PSSNL,PSSNLF,PSSNLX
+14 SET ^PSDRUG(PSSD,"DOS2",PSSLTOT,0)=$GET(PSALL)_"^"_$GET(PSNOUNPA)
SET ^PSDRUG(PSSD,"DOS2","B",$EXTRACT(PSALL,1,30),PSSLTOT)=""
SET PSSLTOT=PSSLTOT+1
End DoDot:3
End DoDot:2
End DoDot:1
IF PSSLTOT>1
SET PSSLTOTX=PSSLTOT-1
SET ^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$GET(PSSLTOTX)_"^"_$GET(PSSLTOTX)
QUIT
+15 SET PSSLTOT=1
FOR PSNOUN=0:0
SET PSNOUN=$ORDER(^PS(50.606,PSSOID,"NOUN",PSNOUN))
IF 'PSNOUN
QUIT
SET PSNOUNPT=$PIECE($GET(^(PSNOUN,0)),"^")
SET PSNOUNPA=$PIECE($GET(^(0)),"^",2)
IF PSNOUNPT'=""
Begin DoDot:1
+16 IF PSNOUNPA=""
QUIT
+17 IF $GET(PSSONLYI)
IF PSNOUNPA'["I"
QUIT
+18 IF $GET(PSSONLYO)
IF PSNOUNPA'["O"
QUIT
+19 SET ^PSDRUG(PSSD,"DOS2",PSSLTOT,0)=PSNOUNPT_"^"_$GET(PSNOUNPA)
SET ^PSDRUG(PSSD,"DOS2","B",$EXTRACT(PSNOUNPT,1,30),PSSLTOT)=""
SET PSSLTOT=PSSLTOT+1
End DoDot:1
+20 IF PSSLTOT>1
SET PSSLTOTX=PSSLTOT-1
SET ^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$GET(PSSLTOTX)_"^"_$GET(PSSLTOTX)
+21 QUIT
WHO ;
+1 KILL PSSWHOAR
SET DA=+$PIECE($GET(^PS(59.7,PSSTRAC,80)),"^",6)
SET DIC=200
SET DR=".01"
SET DIQ(0)="E"
SET DIQ="PSSWHOAR"
DO EN^DIQ1
SET PSSWHO=$GET(PSSWHOAR(200,DA,.01,"E"))
KILL DIQ,PSSWHOAR,DR,DA,DIC
+2 QUIT
TEST ;
+1 KILL PSSNL,PSSNLF,PSSNLX
+2 IF $GET(PSNOUNPT)=""
QUIT
+3 IF $LENGTH(PSNOUNPT)'>3
QUIT
+4 SET PSSNL=$EXTRACT(PSNOUNPT,($LENGTH(PSNOUNPT)-2),$LENGTH(PSNOUNPT))
+5 IF $GET(PSSNL)="(S)"!($GET(PSSNL)="(s)")
SET PSSNLF=1
Begin DoDot:1
+6 IF $GET(PSDUPDPT)'>1
SET PSSNLX=$EXTRACT(PSNOUNPT,1,($LENGTH(PSNOUNPT)-3))
+7 IF $GET(PSDUPDPT)>1
SET PSSNLX=$EXTRACT(PSNOUNPT,1,($LENGTH(PSNOUNPT)-3))_$EXTRACT(PSSNL,2)
End DoDot:1
+8 QUIT
