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
