PSS51P2 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.2 ; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85,112,118,88,94**;9/30/97;Build 26
;
ALL(PSSIEN,PSSFT,PSSFL,PSSPK,LIST) ;
;PSSIEN - IEN of entry in MEDICATION ROUTES file (#51.2).
;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
;PSSFL - Inactive flag - "" - All entries
; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
;PSSPK - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
;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 NAME field (#.01), ABBREVIATION field (#1), PACKAGE USE field (#3), OUTPATIENT EXPANSION field (#4),
;OTHER LANGUAGE EXPANSION field (#4.1), INACTIVATION DATE field (#5), and IV FLAG field (#6)
;of MEDICATION ROUTES file (#51.2).
N DIERR,ZZERR,PSS51P2,SCR,PSS,PSSBGCNT,PSSCNT,PSSTIEN,PSSTMP,PSSNAM,PSSCAP
S PSSBGCNT=0
S SCR("S")=""
I $G(LIST)']"" Q
K ^TMP("DILIST",$J)
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 N ND D SETSCRN
;Naked reference below refers to ^PS(51.2,+Y,0)
I $G(PSSPK)]"" S SCR("S")=$S(SCR("S")]"":SCR("S")_" I $P($G(^(0)),U,4)=$G(PSSPK)",1:"I $P($G(^(0)),U,4)=$G(PSSPK)")
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.2,"","A","`"_PSSIEN,,SCR("S"),"") D D COUNTBG Q
.I PSSIEN2>0 D DIRREAD
I +$G(PSSIEN)=0 D
.I PSSFT="??" D LOOPDIR D COUNTBG Q
.D FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B^C",SCR("S"),,"") D LOOPDI D COUNTBG
Q
;
COUNTBG ;CHECKS PSSBGCNT AND FILLS COUNT IN ON 0 NODE OF ^TMP($J,LIST)
I PSSBGCNT>0 D
.S ^TMP($J,LIST,0)=PSSBGCNT
ELSE S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
Q
;
LOOPDI ;LOOPS ON "DILIST" FROM FILEMAN CALL (USED FOR RETURNING MULTIPLE DRUGS FROM PSSFT)
S PSSTIEN=0 ;TEMP IEN TO ITERATE OVER DILIST
F S PSSTIEN=$O(^TMP("DILIST",$J,PSSTIEN)) Q:PSSTIEN="" D
.S PSSIEN2=($P(^TMP("DILIST",$J,PSSTIEN,0),U,1))
.D DIRREAD
Q
;
LOOPDIR ;LOOP FOR A DIRECT READ. READS ALL IENs FOR ^PSDRUG(
S PSSIEN2=0
F S PSSIEN2=$O(^PS(51.2,PSSIEN2)) Q:'PSSIEN2 D
.D DIRALL
Q
;
DIRALL ;TEST FOR PSSFL, PSSPK, BAILS IF CONDITIONS MEET TRUE
I $G(PSSFL),$P($G(^PS(51.2,PSSIEN2,0)),U,5),$P($G(^PS(51.2,PSSIEN2,0)),U,5)'>PSSFL Q
I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^PS(51.2,PSSIEN2,0)),U,4)[$E(PSSPK,PSSZ6) S PSSZ5=1
I $G(PSSPK)]"",'PSSZ5 Q
D DIRREAD
Q
;
DIRREAD ;MAIN DIRECT READ FOR ENTIRE ROUTINE
S PSSNAM=$P($G(^PS(51.2,PSSIEN2,0)),U,1)
S ^TMP($J,LIST,PSSIEN2,.01)=PSSNAM
S ^TMP($J,LIST,PSSIEN2,1)=$P($G(^PS(51.2,PSSIEN2,0)),U,3)
S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,4)
I PSSTMP="0" S ^TMP($J,LIST,PSSIEN2,3)=PSSTMP_U_"NATIONAL DRUG FILE ONLY"
I PSSTMP="1" S ^TMP($J,LIST,PSSIEN2,3)=PSSTMP_U_"ALL PACKAGES"
I PSSTMP="" S ^TMP($J,LIST,PSSIEN2,3)=""
S ^TMP($J,LIST,PSSIEN2,4)=$P($G(^PS(51.2,PSSIEN2,0)),U,2)
S ^TMP($J,LIST,PSSIEN2,4.1)=$P($G(^PS(51.2,PSSIEN2,0)),U,7)
I $P($G(^PS(51.2,PSSIEN2,0)),U,5)'="" D
.S PSSCAP=$$UP^XLFSTR($$FMTE^XLFDT($P($G(^PS(51.2,PSSIEN2,0)),U,5)))
.S ^TMP($J,LIST,PSSIEN2,5)=$P($G(^PS(51.2,PSSIEN2,0)),U,5)_U_PSSCAP
ELSE S ^TMP($J,LIST,PSSIEN2,5)=""
N PSSTMP S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,6)
I PSSTMP="0"!PSSTMP="" S ^TMP($J,LIST,PSSIEN2,6)=PSSTMP_U_"NO"
I PSSTMP="1" D
.S ^TMP($J,LIST,PSSIEN2,6)=PSSTMP_U_"YES"
.S ^TMP($J,LIST,"IV",PSSNAM,PSSIEN2)=""
I PSSTMP="" S ^TMP($J,LIST,PSSIEN2,6)=""
S ^TMP($J,LIST,"B",$P($G(^PS(51.2,PSSIEN2,0)),U,1),PSSIEN2)=""
N PSSAB S PSSAB=$P($G(^PS(51.2,PSSIEN2,0)),U,3) I PSSAB]"" S ^TMP($J,LIST,"C",PSSAB,PSSIEN2)=""
S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,8)
S ^TMP($J,LIST,PSSIEN2,7)=PSSTMP I PSSTMP]"" S ^(7)=^(7)_U_$S(PSSTMP:"YES",1:"NO")
S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,9)
S ^TMP($J,LIST,PSSIEN2,8)=PSSTMP I PSSTMP]"" S ^(8)=^(8)_U_$S(PSSTMP:"YES",1:"NO")
S PSSBGCNT=PSSBGCNT+1
Q
;
SETSCRN ;Set Screen for inactive Medication Routes
;Naked reference below refers to ^PS(51.2,+Y,0)
S SCR("S")="S ND=$P($G(^(0)),U,5) I ND=""""!(ND>PSSFL)"
Q
;
NAME(PSSFT,PSSPK,LIST) ;
;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
;PSSPK - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
;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 NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
;of MEDICATION ROUTES file (#51.2).
N DIERR,ZZERR,PSS51P2,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I ($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
;Naked reference below refers to ^PS(51.2,+Y,0)
S SCR("S")=$S($G(PSSPK)]"":"I $P($G(^(0)),""^"",4)=$G(PSSPK)",1:"")
I PSSFT["??" D LOOP(2) Q
D FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B",SCR("S"),,"")
I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
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("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0
.F S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1) D SETZRO2
K TMP("DILIST",$J),^TMP("PSS51P2",$J)
Q
;
IEN(PSSABBR,LIST) ;
;PSSABBR - ABBREVIATION field (#1) in MEDICATION ROUTES file (#51.2).
;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 NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
;of MEDICATION ROUTES file (#51.2).
N DIERR,ZZERR,PSS51P2,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I ($G(PSSABBR)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
D FIND^DIC(51.2,,"@;.01;1","QP",PSSABBR,,"C",,,"")
I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
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("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0
.F S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1) D SETZRO2
K TMP("DILIST",$J),^TMP("PSS51P2",$J)
Q
;
SETZRO ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),4,"I"))
S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),1,"I"))
S ^TMP($J,LIST,+PSS(1),3)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),3,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),3,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),3,"E"))
S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),5,"E"))
S ^TMP($J,LIST,+PSS(1),6)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),6,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),6,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),6,"E"))
S ^TMP($J,LIST,+PSS(1),4.1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),4.1,"I"))
Q
;
SETZRO2 ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),1,"I"))
S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),5,"E"))
Q
;
LOOP(PSS) ;
N CNT S CNT=0
S PSSIEN=0 F S PSSIEN=$O(^PS(51.2,PSSIEN)) Q:'PSSIEN D @(PSS)
S ^TMP($J,LIST,0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
Q
;
1 ;
S ND=$G(^PS(51.2,+PSSIEN,0))
I +$G(PSSFL)>0 Q:$P($G(ND),"^",5)]""&($P($G(ND),"^",5)'>$G(PSSFL))
I $G(PSSPK)]"" Q:$P($G(ND),"^",4)'=$G(PSSPK)
K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0 D
.F S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1) D SETZRO S CNT=CNT+1
Q
;
2 ;
I $G(PSSPK)]"",$P($G(^PS(51.2,+PSSIEN,0)),"^",4)'=$G(PSSPK) Q
K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0 D
.F S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1) D SETZRO2 S CNT=CNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS51P2 8444 printed Jan 18, 2025@03:30:50 Page 2
PSS51P2 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.2 ; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,112,118,88,94**;9/30/97;Build 26
+2 ;
ALL(PSSIEN,PSSFT,PSSFL,PSSPK,LIST) ;
+1 ;PSSIEN - IEN of entry in MEDICATION ROUTES file (#51.2).
+2 ;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
+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 - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
+6 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
+7 ;the Field Number of the data piece being returned.
+8 ;Returns NAME field (#.01), ABBREVIATION field (#1), PACKAGE USE field (#3), OUTPATIENT EXPANSION field (#4),
+9 ;OTHER LANGUAGE EXPANSION field (#4.1), INACTIVATION DATE field (#5), and IV FLAG field (#6)
+10 ;of MEDICATION ROUTES file (#51.2).
+11 NEW DIERR,ZZERR,PSS51P2,SCR,PSS,PSSBGCNT,PSSCNT,PSSTIEN,PSSTMP,PSSNAM,PSSCAP
+12 SET PSSBGCNT=0
+13 SET SCR("S")=""
+14 IF $GET(LIST)']""
QUIT
+15 KILL ^TMP("DILIST",$JOB)
+16 KILL ^TMP($JOB,LIST)
+17 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+18 SET SCR("S")=""
+19 IF +$GET(PSSFL)>0
NEW ND
DO SETSCRN
+20 ;Naked reference below refers to ^PS(51.2,+Y,0)
+21 IF $GET(PSSPK)]""
SET SCR("S")=$SELECT(SCR("S")]"":SCR("S")_" I $P($G(^(0)),U,4)=$G(PSSPK)",1:"I $P($G(^(0)),U,4)=$G(PSSPK)")
+22 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51.2,"","A","`"_PSSIEN,,SCR("S"),"")
Begin DoDot:1
+23 IF PSSIEN2>0
DO DIRREAD
End DoDot:1
DO COUNTBG
QUIT
+24 IF +$GET(PSSIEN)=0
Begin DoDot:1
+25 IF PSSFT="??"
DO LOOPDIR
DO COUNTBG
QUIT
+26 DO FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B^C",SCR("S"),,"")
DO LOOPDI
DO COUNTBG
End DoDot:1
+27 QUIT
+28 ;
COUNTBG ;CHECKS PSSBGCNT AND FILLS COUNT IN ON 0 NODE OF ^TMP($J,LIST)
+1 IF PSSBGCNT>0
Begin DoDot:1
+2 SET ^TMP($JOB,LIST,0)=PSSBGCNT
End DoDot:1
+3 IF '$TEST
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
+4 QUIT
+5 ;
LOOPDI ;LOOPS ON "DILIST" FROM FILEMAN CALL (USED FOR RETURNING MULTIPLE DRUGS FROM PSSFT)
+1 ;TEMP IEN TO ITERATE OVER DILIST
SET PSSTIEN=0
+2 FOR
SET PSSTIEN=$ORDER(^TMP("DILIST",$JOB,PSSTIEN))
if PSSTIEN=""
QUIT
Begin DoDot:1
+3 SET PSSIEN2=($PIECE(^TMP("DILIST",$JOB,PSSTIEN,0),U,1))
+4 DO DIRREAD
End DoDot:1
+5 QUIT
+6 ;
LOOPDIR ;LOOP FOR A DIRECT READ. READS ALL IENs FOR ^PSDRUG(
+1 SET PSSIEN2=0
+2 FOR
SET PSSIEN2=$ORDER(^PS(51.2,PSSIEN2))
if 'PSSIEN2
QUIT
Begin DoDot:1
+3 DO DIRALL
End DoDot:1
+4 QUIT
+5 ;
DIRALL ;TEST FOR PSSFL, PSSPK, BAILS IF CONDITIONS MEET TRUE
+1 IF $GET(PSSFL)
IF $PIECE($GET(^PS(51.2,PSSIEN2,0)),U,5)
IF $PIECE($GET(^PS(51.2,PSSIEN2,0)),U,5)'>PSSFL
QUIT
+2 IF $GET(PSSPK)]""
NEW PSSZ5,PSSZ6
SET PSSZ5=0
FOR PSSZ6=1:1:$LENGTH(PSSPK)
if PSSZ5
QUIT
IF $PIECE($GET(^PS(51.2,PSSIEN2,0)),U,4)[$EXTRACT(PSSPK,PSSZ6)
SET PSSZ5=1
+3 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+4 DO DIRREAD
+5 QUIT
+6 ;
DIRREAD ;MAIN DIRECT READ FOR ENTIRE ROUTINE
+1 SET PSSNAM=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,1)
+2 SET ^TMP($JOB,LIST,PSSIEN2,.01)=PSSNAM
+3 SET ^TMP($JOB,LIST,PSSIEN2,1)=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,3)
+4 SET PSSTMP=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,4)
+5 IF PSSTMP="0"
SET ^TMP($JOB,LIST,PSSIEN2,3)=PSSTMP_U_"NATIONAL DRUG FILE ONLY"
+6 IF PSSTMP="1"
SET ^TMP($JOB,LIST,PSSIEN2,3)=PSSTMP_U_"ALL PACKAGES"
+7 IF PSSTMP=""
SET ^TMP($JOB,LIST,PSSIEN2,3)=""
+8 SET ^TMP($JOB,LIST,PSSIEN2,4)=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,2)
+9 SET ^TMP($JOB,LIST,PSSIEN2,4.1)=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,7)
+10 IF $PIECE($GET(^PS(51.2,PSSIEN2,0)),U,5)'=""
Begin DoDot:1
+11 SET PSSCAP=$$UP^XLFSTR($$FMTE^XLFDT($PIECE($GET(^PS(51.2,PSSIEN2,0)),U,5)))
+12 SET ^TMP($JOB,LIST,PSSIEN2,5)=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,5)_U_PSSCAP
End DoDot:1
+13 IF '$TEST
SET ^TMP($JOB,LIST,PSSIEN2,5)=""
+14 NEW PSSTMP
SET PSSTMP=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,6)
+15 IF PSSTMP="0"!PSSTMP=""
SET ^TMP($JOB,LIST,PSSIEN2,6)=PSSTMP_U_"NO"
+16 IF PSSTMP="1"
Begin DoDot:1
+17 SET ^TMP($JOB,LIST,PSSIEN2,6)=PSSTMP_U_"YES"
+18 SET ^TMP($JOB,LIST,"IV",PSSNAM,PSSIEN2)=""
End DoDot:1
+19 IF PSSTMP=""
SET ^TMP($JOB,LIST,PSSIEN2,6)=""
+20 SET ^TMP($JOB,LIST,"B",$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,1),PSSIEN2)=""
+21 NEW PSSAB
SET PSSAB=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,3)
IF PSSAB]""
SET ^TMP($JOB,LIST,"C",PSSAB,PSSIEN2)=""
+22 SET PSSTMP=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,8)
+23 SET ^TMP($JOB,LIST,PSSIEN2,7)=PSSTMP
IF PSSTMP]""
SET ^(7)=^(7)_U_$SELECT(PSSTMP:"YES",1:"NO")
+24 SET PSSTMP=$PIECE($GET(^PS(51.2,PSSIEN2,0)),U,9)
+25 SET ^TMP($JOB,LIST,PSSIEN2,8)=PSSTMP
IF PSSTMP]""
SET ^(8)=^(8)_U_$SELECT(PSSTMP:"YES",1:"NO")
+26 SET PSSBGCNT=PSSBGCNT+1
+27 QUIT
+28 ;
SETSCRN ;Set Screen for inactive Medication Routes
+1 ;Naked reference below refers to ^PS(51.2,+Y,0)
+2 SET SCR("S")="S ND=$P($G(^(0)),U,5) I ND=""""!(ND>PSSFL)"
+3 QUIT
+4 ;
NAME(PSSFT,PSSPK,LIST) ;
+1 ;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
+2 ;PSSPK - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
+4 ;the Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
+6 ;of MEDICATION ROUTES file (#51.2).
+7 NEW DIERR,ZZERR,PSS51P2,SCR,PSS
+8 IF $GET(LIST)']""
QUIT
+9 KILL ^TMP($JOB,LIST)
+10 IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 ;Naked reference below refers to ^PS(51.2,+Y,0)
+12 SET SCR("S")=$SELECT($GET(PSSPK)]"":"I $P($G(^(0)),""^"",4)=$G(PSSPK)",1:"")
+13 IF PSSFT["??"
DO LOOP(2)
QUIT
+14 DO FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B",SCR("S"),,"")
+15 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+16 SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
+17 NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:1
+18 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL ^TMP("PSS51P2",$JOB)
DO GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)")
SET PSS(1)=0
+19 FOR
SET PSS(1)=$ORDER(^TMP("PSS51P2",$JOB,51.2,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO2
End DoDot:1
+20 KILL TMP("DILIST",$JOB),^TMP("PSS51P2",$JOB)
+21 QUIT
+22 ;
IEN(PSSABBR,LIST) ;
+1 ;PSSABBR - ABBREVIATION field (#1) in MEDICATION ROUTES file (#51.2).
+2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
+3 ;the Field Number of the data piece being returned.
+4 ;Returns NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
+5 ;of MEDICATION ROUTES file (#51.2).
+6 NEW DIERR,ZZERR,PSS51P2,SCR,PSS
+7 IF $GET(LIST)']""
QUIT
+8 KILL ^TMP($JOB,LIST)
+9 IF ($GET(PSSABBR)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 DO FIND^DIC(51.2,,"@;.01;1","QP",PSSABBR,,"C",,,"")
+11 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+12 SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
+13 NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:1
+14 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL ^TMP("PSS51P2",$JOB)
DO GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)")
SET PSS(1)=0
+15 FOR
SET PSS(1)=$ORDER(^TMP("PSS51P2",$JOB,51.2,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO2
End DoDot:1
+16 KILL TMP("DILIST",$JOB),^TMP("PSS51P2",$JOB)
+17 QUIT
+18 ;
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),4,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),1,"I"))
+5 SET ^TMP($JOB,LIST,+PSS(1),3)=$SELECT($GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),3,"I"))="":"",1:^TMP("PSS51P2",$JOB,51.2,PSS(1),3,"I")_"^"_^TMP("PSS51P2",$JOB,51.2,PSS(1),3,"E"))
+6 SET ^TMP($JOB,LIST,+PSS(1),5)=$SELECT($GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$JOB,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$JOB,51.2,PSS(1),5,"E"))
+7 SET ^TMP($JOB,LIST,+PSS(1),6)=$SELECT($GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),6,"I"))="":"",1:^TMP("PSS51P2",$JOB,51.2,PSS(1),6,"I")_"^"_^TMP("PSS51P2",$JOB,51.2,PSS(1),6,"E"))
+8 SET ^TMP($JOB,LIST,+PSS(1),4.1)=$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),4.1,"I"))
+9 QUIT
+10 ;
SETZRO2 ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),1,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),5)=$SELECT($GET(^TMP("PSS51P2",$JOB,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$JOB,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$JOB,51.2,PSS(1),5,"E"))
+5 QUIT
+6 ;
LOOP(PSS) ;
+1 NEW CNT
SET CNT=0
+2 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^PS(51.2,PSSIEN))
if 'PSSIEN
QUIT
DO @(PSS)
+3 SET ^TMP($JOB,LIST,0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
+4 QUIT
+5 ;
1 ;
+1 SET ND=$GET(^PS(51.2,+PSSIEN,0))
+2 IF +$GET(PSSFL)>0
if $PIECE($GET(ND),"^",5)]""&($PIECE($GET(ND),"^",5)'>$GET(PSSFL))
QUIT
+3 IF $GET(PSSPK)]""
if $PIECE($GET(ND),"^",4)'=$GET(PSSPK)
QUIT
+4 KILL ^TMP("PSS51P2",$JOB)
DO GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)")
SET PSS(1)=0
Begin DoDot:1
+5 FOR
SET PSS(1)=$ORDER(^TMP("PSS51P2",$JOB,51.2,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO
SET CNT=CNT+1
End DoDot:1
+6 QUIT
+7 ;
2 ;
+1 IF $GET(PSSPK)]""
IF $PIECE($GET(^PS(51.2,+PSSIEN,0)),"^",4)'=$GET(PSSPK)
QUIT
+2 KILL ^TMP("PSS51P2",$JOB)
DO GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)")
SET PSS(1)=0
Begin DoDot:1
+3 FOR
SET PSS(1)=$ORDER(^TMP("PSS51P2",$JOB,51.2,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO2
SET CNT=CNT+1
End DoDot:1
+4 QUIT
