PSS50DOS ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;External reference to PS(50.607 supported by DBIA 2221
SDOSE ;
N PSSZR,PSSZR1,PSSZRT,PSSZRT1
S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
S (PSSZR,PSSZR1)="" S PSSZR=$G(^TMP("PSSP50",$J,50,PSS(1),901,"I")) I PSSZR'="" S PSSZR1=$$LEAD(PSSZR)
S ^TMP($J,LIST,+PSS(1),901)=PSSZR1
S (PSSZRT,PSSZRT1)="" I $G(^TMP("PSSP50",$J,50,PSS(1),902,"I"))'="" S PSSZRT=$G(^TMP("PSSP50",$J,50,PSS(1),902,"E"))
I PSSZRT'="" S PSSZRT1=$$LEADU(PSSZRT)
S ^TMP($J,LIST,+PSS(1),902)=$S($G(^TMP("PSSP50",$J,50,PSS(1),902,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),902,"I"))_"^"_$G(PSSZRT1))
Q
;
SDOSE2 ;
N PSSPOSIO,PSSZR2,PSSZR3,PSSZR2T,PSSZR3T
S (PSSZR2,PSSZR2T)=""
S PSSZR2=$G(^TMP("PSSP50",$J,50.0903,PSS(2),.01,"I")) I PSSZR2'="" S PSSZR2T=$$LEAD(PSSZR2)
S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),.01)=PSSZR2T
S (PSSZR3,PSSZR3T)=""
S PSSZR3=$G(^TMP("PSSP50",$J,50.0903,PSS(2),1,"I")) I PSSZR3'="" S PSSZR3T=$$LEAD(PSSZR3)
S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),1)=PSSZR3T
S PSSPOSIO=$G(^TMP("PSSP50",$J,50.0903,PSS(2),2,"I"))
S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),2)=$S($G(PSSPOSIO)="":"",1:PSSPOSIO_"^"_$S(PSSPOSIO="I":"Inpatient",PSSPOSIO="O":"Outpatient",PSSPOSIO="IO":"Both",PSSPOSIO="OI":"Both",1:""))
S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),3)=$G(^TMP("PSSP50",$J,50.0903,PSS(2),3,"I"))
Q
;
SDOSE3 ;
S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),.01)=$G(^TMP("PSSP50",$J,50.0904,PSS(2),.01,"I"))
S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),1)=$S($G(^TMP("PSSP50",$J,50.0904,PSS(2),1,"I"))="":"",1:$G(^TMP("PSSP50",$J,50.0904,PSS(2),1,"I"))_"^"_$G(^TMP("PSSP50",$J,50.0904,PSS(2),1,"E")))
S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),2)=$G(^TMP("PSSP50",$J,50.0904,PSS(2),2,"I"))
S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),3)=$G(^TMP("PSSP50",$J,50.0904,PSS(2),3,"I"))
Q
LOOP ;
N PSSENCT
S PSSENCT=0
S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
.I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
.I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
.I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
.;Naked reference below refers to ^PSDRUG(PSS(1),2)
.I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
.I $G(PSSPK)]"",'PSSZ5 Q
.D SETSUB7^PSS50AQM(PSS(1)),SETSUB8^PSS50AQM(PSS(1))
.D SETLP1,SETLP2,SETLP3
.S PSSENCT=PSSENCT+1
S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
Q
SETLP1 ;
N PSSZNODE,PSS50NOD,PSSZR,PSSZR1,PSSZRT,PSSZRT1
S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50NOD=$G(^("DOS"))
S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
S (PSSZR,PSSZR1)="" S PSSZR=$P(PSS50NOD,"^") I PSSZR'="" S PSSZR1=$$LEAD(PSSZR)
S ^TMP($J,LIST,+PSS(1),901)=PSSZR1
S (PSSZRT,PSSZRT1)="" I $P(PSS50NOD,"^",2) S PSSZRT=$P($G(^PS(50.607,+$P(PSS50NOD,"^",2),0)),"^")
I PSSZRT'="" S PSSZRT1=$$LEADU(PSSZRT)
S ^TMP($J,LIST,+PSS(1),902)=$S($P(PSS50NOD,"^",2):$P(PSS50NOD,"^",2)_"^"_PSSZRT1,1:"")
Q
SETLP2 ;
N PSS903C,PSSZR5,PSSZR6,PSSZR7,PSSZR8 S PSS903C=0
I $O(^PSDRUG(PSS(1),"DOS1",0)) N PSS903,PSS903ND D
.F PSS903=0:0 S PSS903=$O(^PSDRUG(PSS(1),"DOS1",PSS903)) Q:'PSS903 D
..S PSS903ND=$G(^PSDRUG(PSS(1),"DOS1",PSS903,0)) I $P(PSS903ND,"^")'="" S PSS903C=PSS903C+1 D
...S (PSSZR5,PSSZR6)="" S PSSZR5=$P(PSS903ND,"^") I PSSZR5'="" S PSSZR6=$$LEAD(PSSZR5)
...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,.01)=PSSZR6
...S (PSSZR7,PSSZR8)="" S PSSZR7=$P(PSS903ND,"^",2) I PSSZR7'="" S PSSZR8=$$LEAD(PSSZR7)
...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,1)=PSSZR8
...N PSS903IO S PSS903IO=$P(PSS903ND,"^",3)
...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,2)=$S($G(PSS903IO)="":"",1:PSS903IO_"^"_$S(PSS903IO="I":"Inpatient",PSS903IO="O":"Outpatient",PSS903IO="IO":"Both",PSS903IO="OI":"Both",1:""))
...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,3)=$P(PSS903ND,"^",4)
S ^TMP($J,LIST,+PSS(1),"POS",0)=$S(PSS903C:PSS903C,1:"-1^NO DATA FOUND")
Q
SETLP3 ;
N PSS904C S PSS904C=0
I $O(^PSDRUG(PSS(1),"DOS2",0)) N PSS904,PSS904ND D
.F PSS904=0:0 S PSS904=$O(^PSDRUG(PSS(1),"DOS2",PSS904)) Q:'PSS904 D
..S PSS904ND=$G(^PSDRUG(PSS(1),"DOS2",PSS904,0)) I $P(PSS904ND,"^")'="" S PSS904C=PSS904C+1 D
...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,.01)=$P(PSS904ND,"^")
...N PSS904IO S PSS904IO=$P(PSS904ND,"^",2)
...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,1)=$S($G(PSS904IO)="":"",1:PSS904IO_"^"_$S(PSS904IO="I":"Inpatient",PSS904IO="O":"Outpatient",PSS904IO="IO":"Both",PSS904IO="OI":"Both",1:""))
...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,2)=$P(PSS904ND,"^",3)
...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,3)=$P(PSS904ND,"^",4)
S ^TMP($J,LIST,+PSS(1),"LOC",0)=$S(PSS904C:PSS904C,1:"-1^NO DATA FOUND")
Q
LEAD(PSSLEAD) ;Add leading zero to Dose, Dispense Units per Dose, and Strength
Q $S($E($G(PSSLEAD))=".":"0"_$G(PSSLEAD),1:$G(PSSLEAD))
Q
LEADU(PSSLEADU) ;Add leading zero to Unit
N PSSLDU1,PSSLDU2,PSSLDU3
I PSSLEADU'["/" Q $S($E(PSSLEADU)=".":"0"_PSSLEADU,1:PSSLEADU)
S PSSLDU1=$P(PSSLEADU,"/"),PSSLDU2=$P(PSSLEADU,"/",2)
S PSSLDU1=$S($E(PSSLDU1)=".":"0"_PSSLDU1,1:PSSLDU1)
S PSSLDU2=$S($E(PSSLDU2)=".":"0"_PSSLDU2,1:PSSLDU2)
S PSSLD3=PSSLDU1_"/"_PSSLDU2
Q PSSLD3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50DOS 5387 printed Nov 22, 2024@17:39:53 Page 2
PSS50DOS ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;External reference to PS(50.607 supported by DBIA 2221
SDOSE ;
+1 NEW PSSZR,PSSZR1,PSSZRT,PSSZRT1
+2 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I"))
+3 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I")),+PSS(1))=""
+4 SET (PSSZR,PSSZR1)=""
SET PSSZR=$GET(^TMP("PSSP50",$JOB,50,PSS(1),901,"I"))
IF PSSZR'=""
SET PSSZR1=$$LEAD(PSSZR)
+5 SET ^TMP($JOB,LIST,+PSS(1),901)=PSSZR1
+6 SET (PSSZRT,PSSZRT1)=""
IF $GET(^TMP("PSSP50",$JOB,50,PSS(1),902,"I"))'=""
SET PSSZRT=$GET(^TMP("PSSP50",$JOB,50,PSS(1),902,"E"))
+7 IF PSSZRT'=""
SET PSSZRT1=$$LEADU(PSSZRT)
+8 SET ^TMP($JOB,LIST,+PSS(1),902)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),902,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),902,"I"))_"^"_$GET(PSSZRT1))
+9 QUIT
+10 ;
SDOSE2 ;
+1 NEW PSSPOSIO,PSSZR2,PSSZR3,PSSZR2T,PSSZR3T
+2 SET (PSSZR2,PSSZR2T)=""
+3 SET PSSZR2=$GET(^TMP("PSSP50",$JOB,50.0903,PSS(2),.01,"I"))
IF PSSZR2'=""
SET PSSZR2T=$$LEAD(PSSZR2)
+4 SET ^TMP($JOB,LIST,+PSS(1),"POS",+PSS(2),.01)=PSSZR2T
+5 SET (PSSZR3,PSSZR3T)=""
+6 SET PSSZR3=$GET(^TMP("PSSP50",$JOB,50.0903,PSS(2),1,"I"))
IF PSSZR3'=""
SET PSSZR3T=$$LEAD(PSSZR3)
+7 SET ^TMP($JOB,LIST,+PSS(1),"POS",+PSS(2),1)=PSSZR3T
+8 SET PSSPOSIO=$GET(^TMP("PSSP50",$JOB,50.0903,PSS(2),2,"I"))
+9 SET ^TMP($JOB,LIST,+PSS(1),"POS",+PSS(2),2)=$SELECT($GET(PSSPOSIO)="":"",1:PSSPOSIO_"^"_$SELECT(PSSPOSIO="I":"Inpatient",PSSPOSIO="O":"Outpatient",PSSPOSIO="IO":"Both",PSSPOSIO="OI":"Both",1:""))
+10 SET ^TMP($JOB,LIST,+PSS(1),"POS",+PSS(2),3)=$GET(^TMP("PSSP50",$JOB,50.0903,PSS(2),3,"I"))
+11 QUIT
+12 ;
SDOSE3 ;
+1 SET ^TMP($JOB,LIST,+PSS(1),"LOC",+PSS(2),.01)=$GET(^TMP("PSSP50",$JOB,50.0904,PSS(2),.01,"I"))
+2 SET ^TMP($JOB,LIST,+PSS(1),"LOC",+PSS(2),1)=$SELECT($GET(^TMP("PSSP50",$JOB,50.0904,PSS(2),1,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50.0904,PSS(2),1,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50.0904,PSS(2),1,"E")))
+3 SET ^TMP($JOB,LIST,+PSS(1),"LOC",+PSS(2),2)=$GET(^TMP("PSSP50",$JOB,50.0904,PSS(2),2,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),"LOC",+PSS(2),3)=$GET(^TMP("PSSP50",$JOB,50.0904,PSS(2),3,"I"))
+5 QUIT
LOOP ;
+1 NEW PSSENCT
+2 SET PSSENCT=0
+3 SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^PSDRUG(PSS(1),0)),"^")=""
QUIT
+5 IF $GET(PSSFL)
IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
IF $PIECE($GET(^("I")),"^")'>PSSFL
QUIT
+6 IF $GET(PSSRTOI)=1
IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")
QUIT
+7 ;Naked reference below refers to ^PSDRUG(PSS(1),2)
+8 IF $GET(PSSPK)]""
NEW PSSZ5,PSSZ6
SET PSSZ5=0
FOR PSSZ6=1:1:$LENGTH(PSSPK)
if PSSZ5
QUIT
IF $PIECE($GET(^(2)),"^",3)[$EXTRACT(PSSPK,PSSZ6)
SET PSSZ5=1
+9 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+10 DO SETSUB7^PSS50AQM(PSS(1))
DO SETSUB8^PSS50AQM(PSS(1))
+11 DO SETLP1
DO SETLP2
DO SETLP3
+12 SET PSSENCT=PSSENCT+1
End DoDot:1
+13 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")
+14 QUIT
SETLP1 ;
+1 NEW PSSZNODE,PSS50NOD,PSSZR,PSSZR1,PSSZRT,PSSZRT1
+2 SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
SET PSS50NOD=$GET(^("DOS"))
+3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
+4 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
+5 SET (PSSZR,PSSZR1)=""
SET PSSZR=$PIECE(PSS50NOD,"^")
IF PSSZR'=""
SET PSSZR1=$$LEAD(PSSZR)
+6 SET ^TMP($JOB,LIST,+PSS(1),901)=PSSZR1
+7 SET (PSSZRT,PSSZRT1)=""
IF $PIECE(PSS50NOD,"^",2)
SET PSSZRT=$PIECE($GET(^PS(50.607,+$PIECE(PSS50NOD,"^",2),0)),"^")
+8 IF PSSZRT'=""
SET PSSZRT1=$$LEADU(PSSZRT)
+9 SET ^TMP($JOB,LIST,+PSS(1),902)=$SELECT($PIECE(PSS50NOD,"^",2):$PIECE(PSS50NOD,"^",2)_"^"_PSSZRT1,1:"")
+10 QUIT
SETLP2 ;
+1 NEW PSS903C,PSSZR5,PSSZR6,PSSZR7,PSSZR8
SET PSS903C=0
+2 IF $ORDER(^PSDRUG(PSS(1),"DOS1",0))
NEW PSS903,PSS903ND
Begin DoDot:1
+3 FOR PSS903=0:0
SET PSS903=$ORDER(^PSDRUG(PSS(1),"DOS1",PSS903))
if 'PSS903
QUIT
Begin DoDot:2
+4 SET PSS903ND=$GET(^PSDRUG(PSS(1),"DOS1",PSS903,0))
IF $PIECE(PSS903ND,"^")'=""
SET PSS903C=PSS903C+1
Begin DoDot:3
+5 SET (PSSZR5,PSSZR6)=""
SET PSSZR5=$PIECE(PSS903ND,"^")
IF PSSZR5'=""
SET PSSZR6=$$LEAD(PSSZR5)
+6 SET ^TMP($JOB,LIST,+PSS(1),"POS",PSS903,.01)=PSSZR6
+7 SET (PSSZR7,PSSZR8)=""
SET PSSZR7=$PIECE(PSS903ND,"^",2)
IF PSSZR7'=""
SET PSSZR8=$$LEAD(PSSZR7)
+8 SET ^TMP($JOB,LIST,+PSS(1),"POS",PSS903,1)=PSSZR8
+9 NEW PSS903IO
SET PSS903IO=$PIECE(PSS903ND,"^",3)
+10 SET ^TMP($JOB,LIST,+PSS(1),"POS",PSS903,2)=$SELECT($GET(PSS903IO)="":"",1:PSS903IO_"^"_$SELECT(PSS903IO="I":"Inpatient",PSS903IO="O":"Outpatient",PSS903IO="IO":"Both",PSS903IO="OI":"Both",1:""))
+11 SET ^TMP($JOB,LIST,+PSS(1),"POS",PSS903,3)=$PIECE(PSS903ND,"^",4)
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET ^TMP($JOB,LIST,+PSS(1),"POS",0)=$SELECT(PSS903C:PSS903C,1:"-1^NO DATA FOUND")
+13 QUIT
SETLP3 ;
+1 NEW PSS904C
SET PSS904C=0
+2 IF $ORDER(^PSDRUG(PSS(1),"DOS2",0))
NEW PSS904,PSS904ND
Begin DoDot:1
+3 FOR PSS904=0:0
SET PSS904=$ORDER(^PSDRUG(PSS(1),"DOS2",PSS904))
if 'PSS904
QUIT
Begin DoDot:2
+4 SET PSS904ND=$GET(^PSDRUG(PSS(1),"DOS2",PSS904,0))
IF $PIECE(PSS904ND,"^")'=""
SET PSS904C=PSS904C+1
Begin DoDot:3
+5 SET ^TMP($JOB,LIST,+PSS(1),"LOC",PSS904,.01)=$PIECE(PSS904ND,"^")
+6 NEW PSS904IO
SET PSS904IO=$PIECE(PSS904ND,"^",2)
+7 SET ^TMP($JOB,LIST,+PSS(1),"LOC",PSS904,1)=$SELECT($GET(PSS904IO)="":"",1:PSS904IO_"^"_$SELECT(PSS904IO="I":"Inpatient",PSS904IO="O":"Outpatient",PSS904IO="IO":"Both",PSS904IO="OI":"Both",1:""))
+8 SET ^TMP($JOB,LIST,+PSS(1),"LOC",PSS904,2)=$PIECE(PSS904ND,"^",3)
+9 SET ^TMP($JOB,LIST,+PSS(1),"LOC",PSS904,3)=$PIECE(PSS904ND,"^",4)
End DoDot:3
End DoDot:2
End DoDot:1
+10 SET ^TMP($JOB,LIST,+PSS(1),"LOC",0)=$SELECT(PSS904C:PSS904C,1:"-1^NO DATA FOUND")
+11 QUIT
LEAD(PSSLEAD) ;Add leading zero to Dose, Dispense Units per Dose, and Strength
+1 QUIT $SELECT($EXTRACT($GET(PSSLEAD))=".":"0"_$GET(PSSLEAD),1:$GET(PSSLEAD))
+2 QUIT
LEADU(PSSLEADU) ;Add leading zero to Unit
+1 NEW PSSLDU1,PSSLDU2,PSSLDU3
+2 IF PSSLEADU'["/"
QUIT $SELECT($EXTRACT(PSSLEADU)=".":"0"_PSSLEADU,1:PSSLEADU)
+3 SET PSSLDU1=$PIECE(PSSLEADU,"/")
SET PSSLDU2=$PIECE(PSSLEADU,"/",2)
+4 SET PSSLDU1=$SELECT($EXTRACT(PSSLDU1)=".":"0"_PSSLDU1,1:PSSLDU1)
+5 SET PSSLDU2=$SELECT($EXTRACT(PSSLDU2)=".":"0"_PSSLDU2,1:PSSLDU2)
+6 SET PSSLD3=PSSLDU1_"/"_PSSLDU2
+7 QUIT PSSLD3
+8
