- PSS50C ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
- ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- ;
- WS ;
- ;PSSIEN - IEN of entry in 50
- ;PSSFT - Free Text name in 50
- ;PSSFL - Inactive flag - "" - All entries
- ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- ;PSSPK - Application Package's Use - "" - All entries
- ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- ; part of their formulary.
- ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- ; piece being returned.
- ;Returns PSG node of 50
- N DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S SCR("S")=""
- I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
- I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
- .K ^TMP("DIERR",$J)
- .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;300:302","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETWS^PSS50C1
- I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I $G(PSSFT)]"" D
- .I PSSFT["??" D LOOP^PSS50C1 Q
- .K ^TMP("DILIST",$J)
- .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
- ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
- ..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;300:302","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETWS^PSS50C1
- K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
- Q
- ;
- MRTN ;
- ;PSSIEN - IEN of entry in 50
- ;PSSFT - Free Text name in 50
- ;PSSFL - Inactive flag - "" - All entries
- ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- ;PSSPK - Application Package's Use - "" - All entries
- ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- ; part of their formulary.
- ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- ; piece being returned.
- ;Returns GENERIC NAME (#.01),LAB TEST MONITOR (#17.2),MONITOR ROUTINE (#17.5), and NDC (#31)
- N DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S SCR("S")=""
- I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
- I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
- .K ^TMP("DIERR",$J)
- .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;17.2;17.5;31","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETMRTN^PSS50C1
- I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I $G(PSSFT)]"" D
- .I PSSFT["??" D LOOPMR^PSS50C1 Q
- .K ^TMP("DILIST",$J)
- .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
- ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
- ..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;17.2;17.5;31","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETMRTN^PSS50C1
- K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
- Q
- ;
- ZERO ;
- ;PSSIEN - IEN of entry in 50
- ;PSSFT - Free Text name in 50
- ;PSSFL - Inactive flag - "" - All entries
- ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- ;PSSPK - Application Package's Use - "" - All entries
- ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- ; part of their formulary.
- ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- ; piece being returned.
- ;Returns zero node of 50
- N DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S SCR("S")=""
- I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
- I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
- .K ^TMP("DIERR",$J)
- .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;2:8;51:52;101","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETZRO^PSS50C1
- I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I $G(PSSFT)]"" D
- .I PSSFT["??" D LOOPZR^PSS50C1 Q
- .K ^TMP("DILIST",$J)
- .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
- ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
- ..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;2:8;51:52;101","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETZRO^PSS50C1
- K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
- Q
- ;
- NOCMOP(PSSIEN2,PSSFL2) ;
- ;PSSIEN - IEN of entry in 50
- ;PSSFL - 1 check ^PSDRUG(D0,3)=1
- ; 0 or "" check ^PSDRUG(D0,3)=0 or ""
- I +$G(PSSIEN2)'>0 Q 0
- N NDNODE,INODE,NODE2,NODE3,ZNODE
- S NDNODE=$G(^PSDRUG(+PSSIEN2,"ND")),INODE=$G(^("I")),NODE3=$G(^(3)),NODE2=$G(^(2)),ZNODE=$G(^(0))
- I $P(NODE2,"^",3)["O",$P(NDNODE,"^",2)]"",INODE="",$S($G(PSSFL2)=1:NODE3=0,1:'$D(^PSDRUG(+PSSIEN2,3))) Q 1
- Q 0
- ;
- MSG ;
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- ; piece being returned.
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- N ZNODE,NODE5,INODE
- S ^TMP($J,LIST,0)=0
- S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
- .S ZNODE=$G(^PSDRUG(+PSS(1),0)),NODE5=$G(^(5)),INODE=$G(^("I"))
- .I NODE5]"" S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1,^TMP($J,LIST,+PSS(1),.01)=$P(ZNODE,"^") D
- ..S ^TMP($J,LIST,"B",$P(ZNODE,"^"),+PSS(1))=""
- ..I INODE]"" S Y=INODE D DD^%DT S INODE=INODE_"^"_Y
- ..S ^TMP($J,LIST,+PSS(1),100)=INODE
- Q
- ;
- IEN ;
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- ; piece being returned.
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- N NDNODE,INODE,ZNODE
- S ^TMP($J,LIST,0)=0
- S PSS(1)="" F S PSS(1)=$O(^PSDRUG("IU",PSS(1))) Q:PSS(1)="" D
- .Q:PSS(1)'["O" S PSS(2)=0 F S PSS(2)=$O(^PSDRUG("IU",PSS(1),PSS(2))) Q:'PSS(2) D
- ..S NDNODE=$G(^PSDRUG(PSS(2),"ND")),INODE=$G(^("I")),ZNODE=$G(^(0))
- ..I $P(NDNODE,"^",2)]"",INODE="" D
- ...S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1,^TMP($J,LIST,+PSS(2),.01)=$P(ZNODE,"^")
- ...S ^TMP($J,LIST,"IU",$P(ZNODE,"^"),+PSS(2))=""
- Q
- ;
- AB ;
- ;PSSVAL - ITEM NUMBER sub-field (#.01) of the IFCAP ITEM NUMBER multiple of the DRUG file (#50)
- ;PSSFL - Inactive flag - "" - All entries
- ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- ;PSSPK - Application Package's Use - "" - All entries
- ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- ; part of their formulary.
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- ; piece being returned.
- ;Returns zero node of 50
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSSVAL)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- N PSS,CNT,PSSIEN S (CNT,PSS)=0 F S PSS=$O(^PSDRUG("AB",+PSSVAL,PSS)) Q:'PSS D
- .N INODE,NODE2 S NODE2=$G(^PSDRUG(+PSS,2)),INODE=$G(^("I"))
- .I +$G(PSSFL)>0,+INODE>0,+INODE'>PSSFL Q
- .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
- .K ^TMP($J,"PSS50") D GETS^DIQ(50,+PSS,".01;441*","IE","^TMP($J,""PSS50""") D
- ..S PSS(1)=0 F S PSS(1)=$O(^TMP($J,"PSS50",50,PSS(1))) Q:'PSS(1) D
- ...S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS50",50,PSS(1),.01,"I")),CNT=CNT+1
- ...S ^TMP($J,LIST,"AB",$G(^TMP($J,"PSS50",50,PSS(1),.01,"I")),+PSS(1))="",PSSIEN=+PSS(1)
- ..S (CNT(1),PSS(2))=0 F S PSS(2)=$O(^TMP($J,"PSS50",50.0441,PSS(2))) Q:'PSS(2) D
- ...S ^TMP($J,LIST,+PSSIEN,"IFC",+PSS(2),.01)=$G(^TMP($J,"PSS50",50.0441,PSS(2),.01,"I")),CNT(1)=CNT(1)+1
- ..S ^TMP($J,LIST,+PSSIEN,"IFC",0)=$S(CNT(1)>0:CNT(1),1:"-1^NO DATA FOUND")
- S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
- K ^TMP($J,"PSS50")
- Q
- PSS50C ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- +2 ;
- WS ;
- +1 ;PSSIEN - IEN of entry in 50
- +2 ;PSSFT - Free Text name in 50
- +3 ;PSSFL - Inactive flag - "" - All entries
- +4 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- +5 ;PSSPK - Application Package's Use - "" - All entries
- +6 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- +7 ; part of their formulary.
- +8 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- +9 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +10 ; piece being returned.
- +11 ;Returns PSG node of 50
- +12 NEW DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
- +13 IF $GET(LIST)']""
- QUIT
- +14 KILL ^TMP($JOB,LIST)
- +15 IF +$GET(PSSIEN)'>0
- IF ($GET(PSSFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +16 SET SCR("S")=""
- +17 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")!($GET(PSSRTOI)=1)
- NEW PSS5ND,PSSZ3,PSSZ4
- DO SETSCRN^PSS50A
- +18 IF +$GET(PSSIEN)>0
- NEW PSSIEN2
- SET PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"")
- Begin DoDot:1
- +19 KILL ^TMP("DIERR",$JOB)
- +20 IF +PSSIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +21 SET ^TMP($JOB,LIST,0)=1
- +22 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN2,".01;300:302","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +23 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- IF 'PSS(1)
- QUIT
- DO SETWS^PSS50C1
- End DoDot:1
- KILL ^TMP("PSSP50",$JOB)
- QUIT
- +24 IF $GET(PSSIEN)'=""
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +25 IF $GET(PSSFT)]""
- Begin DoDot:1
- +26 IF PSSFT["??"
- DO LOOP^PSS50C1
- QUIT
- +27 KILL ^TMP("DILIST",$JOB)
- +28 DO FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- +29 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +30 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSSXX
- SET PSSXX=0
- FOR
- SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
- IF 'PSSXX
- QUIT
- Begin DoDot:2
- +31 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
- +32 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN,".01;300:302","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +33 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- IF 'PSS(1)
- QUIT
- DO SETWS^PSS50C1
- End DoDot:2
- End DoDot:1
- +34 KILL ^TMP("DILIST",$JOB),^TMP("PSSP50",$JOB)
- +35 QUIT
- +36 ;
- MRTN ;
- +1 ;PSSIEN - IEN of entry in 50
- +2 ;PSSFT - Free Text name in 50
- +3 ;PSSFL - Inactive flag - "" - All entries
- +4 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- +5 ;PSSPK - Application Package's Use - "" - All entries
- +6 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- +7 ; part of their formulary.
- +8 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- +9 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +10 ; piece being returned.
- +11 ;Returns GENERIC NAME (#.01),LAB TEST MONITOR (#17.2),MONITOR ROUTINE (#17.5), and NDC (#31)
- +12 NEW DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
- +13 IF $GET(LIST)']""
- QUIT
- +14 KILL ^TMP($JOB,LIST)
- +15 IF +$GET(PSSIEN)'>0
- IF ($GET(PSSFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +16 SET SCR("S")=""
- +17 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")!($GET(PSSRTOI)=1)
- NEW PSS5ND,PSSZ3,PSSZ4
- DO SETSCRN^PSS50A
- +18 IF +$GET(PSSIEN)>0
- NEW PSSIEN2
- SET PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"")
- Begin DoDot:1
- +19 KILL ^TMP("DIERR",$JOB)
- +20 IF +PSSIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +21 SET ^TMP($JOB,LIST,0)=1
- +22 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN2,".01;17.2;17.5;31","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +23 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- IF 'PSS(1)
- QUIT
- DO SETMRTN^PSS50C1
- End DoDot:1
- KILL ^TMP("PSSP50",$JOB)
- QUIT
- +24 IF $GET(PSSIEN)'=""
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +25 IF $GET(PSSFT)]""
- Begin DoDot:1
- +26 IF PSSFT["??"
- DO LOOPMR^PSS50C1
- QUIT
- +27 KILL ^TMP("DILIST",$JOB)
- +28 DO FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- +29 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +30 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSSXX
- SET PSSXX=0
- FOR
- SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
- IF 'PSSXX
- QUIT
- Begin DoDot:2
- +31 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
- +32 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN,".01;17.2;17.5;31","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +33 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- IF 'PSS(1)
- QUIT
- DO SETMRTN^PSS50C1
- End DoDot:2
- End DoDot:1
- +34 KILL ^TMP("DILIST",$JOB),^TMP("PSSP50",$JOB)
- +35 QUIT
- +36 ;
- ZERO ;
- +1 ;PSSIEN - IEN of entry in 50
- +2 ;PSSFT - Free Text name in 50
- +3 ;PSSFL - Inactive flag - "" - All entries
- +4 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- +5 ;PSSPK - Application Package's Use - "" - All entries
- +6 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- +7 ; part of their formulary.
- +8 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- +9 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +10 ; piece being returned.
- +11 ;Returns zero node of 50
- +12 NEW DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
- +13 IF $GET(LIST)']""
- QUIT
- +14 KILL ^TMP($JOB,LIST)
- +15 IF +$GET(PSSIEN)'>0
- IF ($GET(PSSFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +16 SET SCR("S")=""
- +17 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")!($GET(PSSRTOI)=1)
- NEW PSS5ND,PSSZ3,PSSZ4
- DO SETSCRN^PSS50A
- +18 IF +$GET(PSSIEN)>0
- NEW PSSIEN2
- SET PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"")
- Begin DoDot:1
- +19 KILL ^TMP("DIERR",$JOB)
- +20 IF +PSSIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +21 SET ^TMP($JOB,LIST,0)=1
- +22 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN2,".01;2:8;51:52;101","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +23 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- IF 'PSS(1)
- QUIT
- DO SETZRO^PSS50C1
- End DoDot:1
- KILL ^TMP("PSSP50",$JOB)
- QUIT
- +24 IF $GET(PSSIEN)'=""
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +25 IF $GET(PSSFT)]""
- Begin DoDot:1
- +26 IF PSSFT["??"
- DO LOOPZR^PSS50C1
- QUIT
- +27 KILL ^TMP("DILIST",$JOB)
- +28 DO FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- +29 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +30 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSSXX
- SET PSSXX=0
- FOR
- SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
- IF 'PSSXX
- QUIT
- Begin DoDot:2
- +31 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
- +32 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN,".01;2:8;51:52;101","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +33 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- IF 'PSS(1)
- QUIT
- DO SETZRO^PSS50C1
- End DoDot:2
- End DoDot:1
- +34 KILL ^TMP("DILIST",$JOB),^TMP("PSSP50",$JOB)
- +35 QUIT
- +36 ;
- NOCMOP(PSSIEN2,PSSFL2) ;
- +1 ;PSSIEN - IEN of entry in 50
- +2 ;PSSFL - 1 check ^PSDRUG(D0,3)=1
- +3 ; 0 or "" check ^PSDRUG(D0,3)=0 or ""
- +4 IF +$GET(PSSIEN2)'>0
- QUIT 0
- +5 NEW NDNODE,INODE,NODE2,NODE3,ZNODE
- +6 SET NDNODE=$GET(^PSDRUG(+PSSIEN2,"ND"))
- SET INODE=$GET(^("I"))
- SET NODE3=$GET(^(3))
- SET NODE2=$GET(^(2))
- SET ZNODE=$GET(^(0))
- +7 IF $PIECE(NODE2,"^",3)["O"
- IF $PIECE(NDNODE,"^",2)]""
- IF INODE=""
- IF $SELECT($GET(PSSFL2)=1:NODE3=0,1:'$DATA(^PSDRUG(+PSSIEN2,3)))
- QUIT 1
- +8 QUIT 0
- +9 ;
- MSG ;
- +1 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +2 ; piece being returned.
- +3 IF $GET(LIST)']""
- QUIT
- +4 KILL ^TMP($JOB,LIST)
- +5 NEW ZNODE,NODE5,INODE
- +6 SET ^TMP($JOB,LIST,0)=0
- +7 SET PSS(1)=0
- FOR
- SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
- IF 'PSS(1)
- QUIT
- Begin DoDot:1
- +8 SET ZNODE=$GET(^PSDRUG(+PSS(1),0))
- SET NODE5=$GET(^(5))
- SET INODE=$GET(^("I"))
- +9 IF NODE5]""
- SET ^TMP($JOB,LIST,0)=^TMP($JOB,LIST,0)+1
- SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(ZNODE,"^")
- Begin DoDot:2
- +10 SET ^TMP($JOB,LIST,"B",$PIECE(ZNODE,"^"),+PSS(1))=""
- +11 IF INODE]""
- SET Y=INODE
- DO DD^%DT
- SET INODE=INODE_"^"_Y
- +12 SET ^TMP($JOB,LIST,+PSS(1),100)=INODE
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- IEN ;
- +1 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +2 ; piece being returned.
- +3 IF $GET(LIST)']""
- QUIT
- +4 KILL ^TMP($JOB,LIST)
- +5 NEW NDNODE,INODE,ZNODE
- +6 SET ^TMP($JOB,LIST,0)=0
- +7 SET PSS(1)=""
- FOR
- SET PSS(1)=$ORDER(^PSDRUG("IU",PSS(1)))
- IF PSS(1)=""
- QUIT
- Begin DoDot:1
- +8 IF PSS(1)'["O"
- QUIT
- SET PSS(2)=0
- FOR
- SET PSS(2)=$ORDER(^PSDRUG("IU",PSS(1),PSS(2)))
- IF 'PSS(2)
- QUIT
- Begin DoDot:2
- +9 SET NDNODE=$GET(^PSDRUG(PSS(2),"ND"))
- SET INODE=$GET(^("I"))
- SET ZNODE=$GET(^(0))
- +10 IF $PIECE(NDNODE,"^",2)]""
- IF INODE=""
- Begin DoDot:3
- +11 SET ^TMP($JOB,LIST,0)=^TMP($JOB,LIST,0)+1
- SET ^TMP($JOB,LIST,+PSS(2),.01)=$PIECE(ZNODE,"^")
- +12 SET ^TMP($JOB,LIST,"IU",$PIECE(ZNODE,"^"),+PSS(2))=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- AB ;
- +1 ;PSSVAL - ITEM NUMBER sub-field (#.01) of the IFCAP ITEM NUMBER multiple of the DRUG file (#50)
- +2 ;PSSFL - Inactive flag - "" - All entries
- +3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- +4 ;PSSPK - Application Package's Use - "" - All entries
- +5 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- +6 ; part of their formulary.
- +7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +8 ; piece being returned.
- +9 ;Returns zero node of 50
- +10 IF $GET(LIST)']""
- QUIT
- +11 KILL ^TMP($JOB,LIST)
- +12 IF +$GET(PSSVAL)'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +13 NEW PSS,CNT,PSSIEN
- SET (CNT,PSS)=0
- FOR
- SET PSS=$ORDER(^PSDRUG("AB",+PSSVAL,PSS))
- IF 'PSS
- QUIT
- Begin DoDot:1
- +14 NEW INODE,NODE2
- SET NODE2=$GET(^PSDRUG(+PSS,2))
- SET INODE=$GET(^("I"))
- +15 IF +$GET(PSSFL)>0
- IF +INODE>0
- IF +INODE'>PSSFL
- QUIT
- +16 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
- +17 IF $GET(PSSPK)]""
- IF 'PSSZ5
- QUIT
- +18 KILL ^TMP($JOB,"PSS50")
- DO GETS^DIQ(50,+PSS,".01;441*","IE","^TMP($J,""PSS50""")
- Begin DoDot:2
- +19 SET PSS(1)=0
- FOR
- SET PSS(1)=$ORDER(^TMP($JOB,"PSS50",50,PSS(1)))
- IF 'PSS(1)
- QUIT
- Begin DoDot:3
- +20 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP($JOB,"PSS50",50,PSS(1),.01,"I"))
- SET CNT=CNT+1
- +21 SET ^TMP($JOB,LIST,"AB",$GET(^TMP($JOB,"PSS50",50,PSS(1),.01,"I")),+PSS(1))=""
- SET PSSIEN=+PSS(1)
- End DoDot:3
- +22 SET (CNT(1),PSS(2))=0
- FOR
- SET PSS(2)=$ORDER(^TMP($JOB,"PSS50",50.0441,PSS(2)))
- IF 'PSS(2)
- QUIT
- Begin DoDot:3
- +23 SET ^TMP($JOB,LIST,+PSSIEN,"IFC",+PSS(2),.01)=$GET(^TMP($JOB,"PSS50",50.0441,PSS(2),.01,"I"))
- SET CNT(1)=CNT(1)+1
- End DoDot:3
- +24 SET ^TMP($JOB,LIST,+PSSIEN,"IFC",0)=$SELECT(CNT(1)>0:CNT(1),1:"-1^NO DATA FOUND")
- End DoDot:2
- End DoDot:1
- +25 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
- +26 KILL ^TMP($JOB,"PSS50")
- +27 QUIT
