Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSS50DOS

PSS50DOS.m

Go to the documentation of this file.
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