PSSDOSCX ;BIR/RTR-Dosage conversion routine continued ;03/09/00
;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97
;Reference to ^PS(50.607 supported by DBIA 2221
;
K PSSLPTX,PSSLPNO
F PSSD=0:0 S PSSD=$O(^PSDRUG(PSSD)) Q:'PSSD D D:$G(PSSONLYI)!($G(PSSONLYO))!($G(PSSBOTH)) LOCAL
.S (PSSFLAG,PSSONLYI,PSSONLYO,PSSBOTH)=0
.S PSSND=$P($G(^PSDRUG(PSSD,"ND")),"^",3),PSSND1=$P($G(^("ND")),"^") I 'PSSND!('PSSND1) S PSSBOTH=1 Q
.S X=$$DFSU^PSNAPIS(PSSND1,PSSND) S PSSDF=$P(X,"^"),PSSST=$P(X,"^",4),PSSUN=$P(X,"^",5) K X
.I 'PSSDF!('PSSUN)!($G(PSSST)="") S PSSBOTH=1 Q
.I '$D(^PS(50.606,PSSDF,0))!('$D(^PS(50.607,PSSUN,0))) S PSSBOTH=1 Q
.I $P($G(^PSDRUG(PSSD,"DOS")),"^")'="" S PSSST=$P($G(^("DOS")),"^")
.I PSSST'?.N&(PSSST'?.N1".".N) S PSSBOTH=1 Q
.S (PSSFLAGZ,PSI,PSO)=0 D
..I $D(^PS(50.606,"ACONI",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPI",PSSDF,0)) S PSI=1
..I $D(^PS(50.606,"ACONO",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPO",PSSDF,0)) S PSO=1
.I 'PSO,'PSI S PSSBOTH=1 Q
.I PSI,'PSO D S PSSONLYO=1 Q
..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
...S PSSTODOS=PSSDUPD*PSSST
...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^I",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
.I 'PSI,PSO D S PSSONLYI=1 Q
..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
...S PSSTODOS=PSSDUPD*PSSST
...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
.I PSI,PSO D
..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
...S PSSTODOS=PSSDUPD*PSSST
...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS S $P(^PSDRUG(PSSD,"DOS1",PSSLPT,0),"^",3)=$S($D(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)):"IO",1:"I") S ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
.I PSI,PSO D Q
..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
...Q:$D(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
...S PSSTODOS=PSSDUPD*PSSST
...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
...S ^PSDRUG(PSSD,"DPS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
END K PSSLPTX,PSSLPNO G END^PSSDOSCR
;
LOCAL ;
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 Q
.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^PSSDOSCR
...S PSALL=$G(PSDUPDPT)_" "_$S($G(PSSNLF):$G(PSSNLX),1:$G(PSNOUNPT)) K PSSNL,PSSNLF,PSSNLX
...S (PSSLPT,PSSLPTX,PSSLPNO)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS2",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP I PSALL=$P($G(^PSDRUG(PSSD,"DOS2",PSSLP,0)),"^") S PSSLPNO=1
...Q:PSSLPNO
...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
...S ^PSDRUG(PSSD,"DOS2",PSSLPT,0)=$G(PSALL)_"^"_$G(PSNOUNPA),^PSDRUG(PSSD,"DOS2","B",$E(PSALL,1,30),PSSLPT)="",^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
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(PSSONLYO),PSNOUNPA'["O" Q
.I $G(PSSONLYI),PSNOUNPA'["I" Q
.S (PSSLPT,PSSLPTX,PSSLPNO)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS2",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP I PSNOUNPT=$P($G(^PSDRUG(PSSD,"DOS2",PSSLP,0)),"^") S PSSLPNO=1
.Q:PSSLPNO
.S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
.S ^PSDRUG(PSSD,"DOS2",PSSLPT,0)=$G(PSNOUNPT)_"^"_$G(PSNOUNPA),^PSDRUG(PSSD,"DOS2","B",$E(PSNOUNPT,1,30),PSSLPT)="",^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
Q
PSSDOSCX ;BIR/RTR-Dosage conversion routine continued ;03/09/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97
+2 ;Reference to ^PS(50.607 supported by DBIA 2221
+3 ;
+4 KILL PSSLPTX,PSSLPNO
+5 FOR PSSD=0:0
SET PSSD=$ORDER(^PSDRUG(PSSD))
IF 'PSSD
QUIT
Begin DoDot:1
+6 SET (PSSFLAG,PSSONLYI,PSSONLYO,PSSBOTH)=0
+7 SET PSSND=$PIECE($GET(^PSDRUG(PSSD,"ND")),"^",3)
SET PSSND1=$PIECE($GET(^("ND")),"^")
IF 'PSSND!('PSSND1)
SET PSSBOTH=1
QUIT
+8 SET X=$$DFSU^PSNAPIS(PSSND1,PSSND)
SET PSSDF=$PIECE(X,"^")
SET PSSST=$PIECE(X,"^",4)
SET PSSUN=$PIECE(X,"^",5)
KILL X
+9 IF 'PSSDF!('PSSUN)!($GET(PSSST)="")
SET PSSBOTH=1
QUIT
+10 IF '$DATA(^PS(50.606,PSSDF,0))!('$DATA(^PS(50.607,PSSUN,0)))
SET PSSBOTH=1
QUIT
+11 IF $PIECE($GET(^PSDRUG(PSSD,"DOS")),"^")'=""
SET PSSST=$PIECE($GET(^("DOS")),"^")
+12 IF PSSST'?.N&(PSSST'?.N1".".N)
SET PSSBOTH=1
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 PSI=1
+15 IF $DATA(^PS(50.606,"ACONO",PSSDF,PSSUN))
IF $ORDER(^PS(50.606,"ADUPO",PSSDF,0))
SET PSO=1
End DoDot:2
+16 IF 'PSO
IF 'PSI
SET PSSBOTH=1
QUIT
+17 IF PSI
IF 'PSO
Begin DoDot:2
+18 FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+19 IF $ORDER(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
QUIT
+20 SET PSSTODOS=PSSDUPD*PSSST
+21 SET (PSSLPT,PSSLPTX)=0
FOR PSSLP=0:0
SET PSSLP=$ORDER(^PSDRUG(PSSD,"DOS1",PSSLP))
IF 'PSSLP
QUIT
SET PSSLPTX=PSSLPTX+1
SET PSSLPT=PSSLP
+22 SET PSSLPT=PSSLPT+1
SET PSSLPTX=PSSLPTX+1
+23 SET ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^I"
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)=""
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
+24 SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSLPT)_"^"_$GET(PSSLPTX)
End DoDot:3
End DoDot:2
SET PSSONLYO=1
QUIT
+25 IF 'PSI
IF PSO
Begin DoDot:2
+26 FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPO",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+27 IF $ORDER(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
QUIT
+28 SET PSSTODOS=PSSDUPD*PSSST
+29 SET (PSSLPT,PSSLPTX)=0
FOR PSSLP=0:0
SET PSSLP=$ORDER(^PSDRUG(PSSD,"DOS1",PSSLP))
IF 'PSSLP
QUIT
SET PSSLPTX=PSSLPTX+1
SET PSSLPT=PSSLP
+30 SET PSSLPT=PSSLPT+1
SET PSSLPTX=PSSLPTX+1
+31 SET ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O"
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)=""
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
+32 SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSLPT)_"^"_$GET(PSSLPTX)
End DoDot:3
End DoDot:2
SET PSSONLYI=1
QUIT
+33 IF PSI
IF PSO
Begin DoDot:2
+34 FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+35 IF $ORDER(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
QUIT
+36 SET PSSTODOS=PSSDUPD*PSSST
+37 SET (PSSLPT,PSSLPTX)=0
FOR PSSLP=0:0
SET PSSLP=$ORDER(^PSDRUG(PSSD,"DOS1",PSSLP))
IF 'PSSLP
QUIT
SET PSSLPTX=PSSLPTX+1
SET PSSLPT=PSSLP
+38 SET PSSLPT=PSSLPT+1
SET PSSLPTX=PSSLPTX+1
+39 SET ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS
SET $PIECE(^PSDRUG(PSSD,"DOS1",PSSLPT,0),"^",3)=$SELECT($DATA(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)):"IO",1:"I")
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)=""
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
+40 SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSLPT)_"^"_$GET(PSSLPTX)
End DoDot:3
End DoDot:2
+41 IF PSI
IF PSO
Begin DoDot:2
+42 FOR PSSDUPD=0:0
SET PSSDUPD=$ORDER(^PS(50.606,"ADUPO",PSSDF,PSSDUPD))
IF 'PSSDUPD
QUIT
Begin DoDot:3
+43 IF $ORDER(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
QUIT
+44 IF $DATA(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
QUIT
+45 SET PSSTODOS=PSSDUPD*PSSST
+46 SET (PSSLPT,PSSLPTX)=0
FOR PSSLP=0:0
SET PSSLP=$ORDER(^PSDRUG(PSSD,"DOS1",PSSLP))
IF 'PSSLP
QUIT
SET PSSLPTX=PSSLPTX+1
SET PSSLPT=PSSLP
+47 SET PSSLPT=PSSLPT+1
SET PSSLPTX=PSSLPTX+1
+48 SET ^PSDRUG(PSSD,"DPS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O"
SET ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)=""
SET ^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
+49 SET ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$GET(PSSLPT)_"^"_$GET(PSSLPTX)
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
IF $GET(PSSONLYI)!($GET(PSSONLYO))!($GET(PSSBOTH))
DO LOCAL
END KILL PSSLPTX,PSSLPNO
GOTO END^PSSDOSCR
+1 ;
LOCAL ;
+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 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
+7 IF PSNOUNPA=""
QUIT
+8 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
+9 IF $GET(PSSONLYO)
IF PSNOUNPA'["O"
QUIT
+10 IF $GET(PSSONLYI)
IF PSNOUNPA'["I"
QUIT
+11 DO TEST^PSSDOSCR
+12 SET PSALL=$GET(PSDUPDPT)_" "_$SELECT($GET(PSSNLF):$GET(PSSNLX),1:$GET(PSNOUNPT))
KILL PSSNL,PSSNLF,PSSNLX
+13 SET (PSSLPT,PSSLPTX,PSSLPNO)=0
FOR PSSLP=0:0
SET PSSLP=$ORDER(^PSDRUG(PSSD,"DOS2",PSSLP))
IF 'PSSLP
QUIT
SET PSSLPTX=PSSLPTX+1
SET PSSLPT=PSSLP
IF PSALL=$PIECE($GET(^PSDRUG(PSSD,"DOS2",PSSLP,0)),"^")
SET PSSLPNO=1
+14 IF PSSLPNO
QUIT
+15 SET PSSLPT=PSSLPT+1
SET PSSLPTX=PSSLPTX+1
+16 SET ^PSDRUG(PSSD,"DOS2",PSSLPT,0)=$GET(PSALL)_"^"_$GET(PSNOUNPA)
SET ^PSDRUG(PSSD,"DOS2","B",$EXTRACT(PSALL,1,30),PSSLPT)=""
SET ^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$GET(PSSLPT)_"^"_$GET(PSSLPTX)
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+17 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
+18 IF PSNOUNPA=""
QUIT
+19 IF $GET(PSSONLYO)
IF PSNOUNPA'["O"
QUIT
+20 IF $GET(PSSONLYI)
IF PSNOUNPA'["I"
QUIT
+21 SET (PSSLPT,PSSLPTX,PSSLPNO)=0
FOR PSSLP=0:0
SET PSSLP=$ORDER(^PSDRUG(PSSD,"DOS2",PSSLP))
IF 'PSSLP
QUIT
SET PSSLPTX=PSSLPTX+1
SET PSSLPT=PSSLP
IF PSNOUNPT=$PIECE($GET(^PSDRUG(PSSD,"DOS2",PSSLP,0)),"^")
SET PSSLPNO=1
+22 IF PSSLPNO
QUIT
+23 SET PSSLPT=PSSLPT+1
SET PSSLPTX=PSSLPTX+1
+24 SET ^PSDRUG(PSSD,"DOS2",PSSLPT,0)=$GET(PSNOUNPT)_"^"_$GET(PSNOUNPA)
SET ^PSDRUG(PSSD,"DOS2","B",$EXTRACT(PSNOUNPT,1,30),PSSLPT)=""
SET ^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$GET(PSSLPT)_"^"_$GET(PSSLPTX)
End DoDot:1
+25 QUIT
