- 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
-
- 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
