PSS51P15 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.15; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;
;Reference to ^PS(51.15 is supported by DBIA #2132
;
ALL(PSSIEN,PSSFT,LIST) ;
;PSSIEN - IEN of entry in ADMINISTRATION SHIFT file (#51.15).
;PSSFT - Free Text name in ADMINISTRATION SHIFT file (#51.15).
;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), STANDARD START/STOP TIMES field (#2), PACKAGE field (#4),
;HOSPITAL LOCATION multiple (#51.153), HOSPITAL LOCATION field (#.01), and START/STOP TIMES field (#1)
;of ADMINISTRATION SHIFT file (#51.15).
N DIERR,ZZERR,PSS5115,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.15,"","A","`"_PSSIEN,,,"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(51.15,+PSSIEN2,".01;1;2;4;3*","IE","PSS5115") S PSS(1)=0
.S PSSIEN=+PSSIEN2 F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO S (CNT,PSS(2))=0 D
..F S PSS(2)=$O(PSS5115(51.153,PSS(2))) Q:'PSS(2) D SETLOC S CNT=CNT+1
..S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP(1) Q
.D FIND^DIC(51.15,,"@;.01;1","QP",PSSFT,,"B",,,"")
.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 PSS5115 D GETS^DIQ(51.15,+PSSIEN,".01;1;2;4;3*","IE","PSS5115") S PSS(1)=0
..F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO S (CNT,PSS(2))=0 D
...F S PSS(2)=$O(PSS5115(51.153,PSS(2))) Q:'PSS(2) D SETLOC S CNT=CNT+1
...S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
K ^TMP("DILIST",$J)
Q
;
ACP(PSSPK,PSSABR,LIST) ;
;PSSPK - PACKAGE field (#4) of ADMINISTRATION SHIFT file (#51.15).
;PSSABR - ABBREVIATION field (#1) of ADMINISTRATION SHIFT file (#51.15).
;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 PACKAGE field (#4)
;of ADMINISTRATION SHIFT file (#51.15).
N DIERR,ZZERR,PSS5115,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I $G(PSSPK)']""!($G(PSSABR)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSPK)]"",$G(PSSABR)]"" D
.;Naked reference below refers to ^PS(51.15,+Y,0)
.S SCR("S")="I $P(^(0),""^"",4)=PSSPK"
.D FIND^DIC(51.15,,"@;.01;1","QP",PSSABR,,"C",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 PSS5115 D GETS^DIQ(51.15,+PSSIEN,".01;1;4","IE","PSS5115") S PSS(1)=0
..F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO2
K ^TMP("DILIST",$J)
Q
;
SETZRO ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS5115(51.15,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSS5115(51.15,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),1)=$G(PSS5115(51.15,PSS(1),1,"I"))
S ^TMP($J,LIST,+PSS(1),2)=$G(PSS5115(51.15,PSS(1),2,"I"))
S ^TMP($J,LIST,+PSS(1),4)=$G(PSS5115(51.15,PSS(1),4,"I"))
Q
;
SETLOC ;
S ^TMP($J,LIST,+PSS(1),"HOSP",+PSS(2),.01)=$S($G(PSS5115(51.153,PSS(2),.01,"I"))="":"",1:PSS5115(51.153,PSS(2),.01,"I")_"^"_PSS5115(51.153,PSS(2),.01,"E"))
S ^TMP($J,LIST,+PSS(1),"HOSP",+PSS(2),1)=$G(PSS5115(51.153,PSS(2),1,"I"))
Q
;
SETZRO2 ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS5115(51.15,PSS(1),.01,"I"))
S ^TMP($J,LIST,"ACP",PSSPK,$G(PSS5115(51.15,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),1)=$G(PSS5115(51.15,PSS(1),1,"I"))
S ^TMP($J,LIST,+PSS(1),4)=$G(PSS5115(51.15,PSS(1),4,"I"))
Q
;
LOOP(PSS) ;
N CNT,CNT2 S (CNT2,CNT)=0
S PSSIEN=0 F S PSSIEN=$O(^PS(51.15,PSSIEN)) Q:'PSSIEN D @(PSS)
K ^TMP("DILIST",$J)
Q
;
1 ;
D GETS^DIQ(51.15,+PSSIEN,".01;1;2;4;3*","IE","PSS5115") S PSS(1)=0
F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO S (CNT,PSS(2))=0,CNT2=CNT2+1 D
.F S PSS(2)=$O(PSS5115(51.153,PSS(2))) Q:'PSS(2) D SETLOC S CNT=CNT+1
.S ^TMP($J,LIST,PSSIEN,"HOSP",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
S ^TMP($J,LIST,0)=$S($G(CNT2)>0:CNT2,1:"-1^NO DATA FOUND")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS51P15 4598 printed Sep 23, 2025@20:05:45 Page 2
PSS51P15 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.15; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;
+3 ;Reference to ^PS(51.15 is supported by DBIA #2132
+4 ;
ALL(PSSIEN,PSSFT,LIST) ;
+1 ;PSSIEN - IEN of entry in ADMINISTRATION SHIFT file (#51.15).
+2 ;PSSFT - Free Text name in ADMINISTRATION SHIFT file (#51.15).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number
+4 ; of the data piece being returned.
+5 ;Returns NAME field (#.01), ABBREVIATION field (#1), STANDARD START/STOP TIMES field (#2), PACKAGE field (#4),
+6 ;HOSPITAL LOCATION multiple (#51.153), HOSPITAL LOCATION field (#.01), and START/STOP TIMES field (#1)
+7 ;of ADMINISTRATION SHIFT file (#51.15).
+8 NEW DIERR,ZZERR,PSS5115,PSS
+9 IF $GET(LIST)']""
QUIT
+10 KILL ^TMP($JOB,LIST)
+11 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+12 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51.15,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+13 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 SET ^TMP($JOB,LIST,0)=1
+15 DO GETS^DIQ(51.15,+PSSIEN2,".01;1;2;4;3*","IE","PSS5115")
SET PSS(1)=0
+16 SET PSSIEN=+PSSIEN2
FOR
SET PSS(1)=$ORDER(PSS5115(51.15,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO
SET (CNT,PSS(2))=0
Begin DoDot:2
+17 FOR
SET PSS(2)=$ORDER(PSS5115(51.153,PSS(2)))
if 'PSS(2)
QUIT
DO SETLOC
SET CNT=CNT+1
+18 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+19 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+20 IF PSSFT["??"
DO LOOP(1)
QUIT
+21 DO FIND^DIC(51.15,,"@;.01;1","QP",PSSFT,,"B",,,"")
+22 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+23 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
+24 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS5115
DO GETS^DIQ(51.15,+PSSIEN,".01;1;2;4;3*","IE","PSS5115")
SET PSS(1)=0
+25 FOR
SET PSS(1)=$ORDER(PSS5115(51.15,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO
SET (CNT,PSS(2))=0
Begin DoDot:3
+26 FOR
SET PSS(2)=$ORDER(PSS5115(51.153,PSS(2)))
if 'PSS(2)
QUIT
DO SETLOC
SET CNT=CNT+1
+27 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:3
End DoDot:2
End DoDot:1
+28 KILL ^TMP("DILIST",$JOB)
+29 QUIT
+30 ;
ACP(PSSPK,PSSABR,LIST) ;
+1 ;PSSPK - PACKAGE field (#4) of ADMINISTRATION SHIFT file (#51.15).
+2 ;PSSABR - ABBREVIATION field (#1) of ADMINISTRATION SHIFT file (#51.15).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number
+4 ; of the data piece being returned.
+5 ;Returns NAME field (#.01), ABBREVIATION field (#1), and PACKAGE field (#4)
+6 ;of ADMINISTRATION SHIFT file (#51.15).
+7 NEW DIERR,ZZERR,PSS5115,PSS
+8 IF $GET(LIST)']""
QUIT
+9 KILL ^TMP($JOB,LIST)
+10 IF $GET(PSSPK)']""!($GET(PSSABR)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 IF $GET(PSSPK)]""
IF $GET(PSSABR)]""
Begin DoDot:1
+12 ;Naked reference below refers to ^PS(51.15,+Y,0)
+13 SET SCR("S")="I $P(^(0),""^"",4)=PSSPK"
+14 DO FIND^DIC(51.15,,"@;.01;1","QP",PSSABR,,"C",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)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+17 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS5115
DO GETS^DIQ(51.15,+PSSIEN,".01;1;4","IE","PSS5115")
SET PSS(1)=0
+18 FOR
SET PSS(1)=$ORDER(PSS5115(51.15,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO2
End DoDot:2
End DoDot:1
+19 KILL ^TMP("DILIST",$JOB)
+20 QUIT
+21 ;
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS5115(51.15,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSS5115(51.15,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(PSS5115(51.15,PSS(1),1,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),2)=$GET(PSS5115(51.15,PSS(1),2,"I"))
+5 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(PSS5115(51.15,PSS(1),4,"I"))
+6 QUIT
+7 ;
SETLOC ;
+1 SET ^TMP($JOB,LIST,+PSS(1),"HOSP",+PSS(2),.01)=$SELECT($GET(PSS5115(51.153,PSS(2),.01,"I"))="":"",1:PSS5115(51.153,PSS(2),.01,"I")_"^"_PSS5115(51.153,PSS(2),.01,"E"))
+2 SET ^TMP($JOB,LIST,+PSS(1),"HOSP",+PSS(2),1)=$GET(PSS5115(51.153,PSS(2),1,"I"))
+3 QUIT
+4 ;
SETZRO2 ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS5115(51.15,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"ACP",PSSPK,$GET(PSS5115(51.15,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(PSS5115(51.15,PSS(1),1,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(PSS5115(51.15,PSS(1),4,"I"))
+5 QUIT
+6 ;
LOOP(PSS) ;
+1 NEW CNT,CNT2
SET (CNT2,CNT)=0
+2 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^PS(51.15,PSSIEN))
if 'PSSIEN
QUIT
DO @(PSS)
+3 KILL ^TMP("DILIST",$JOB)
+4 QUIT
+5 ;
1 ;
+1 DO GETS^DIQ(51.15,+PSSIEN,".01;1;2;4;3*","IE","PSS5115")
SET PSS(1)=0
+2 FOR
SET PSS(1)=$ORDER(PSS5115(51.15,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO
SET (CNT,PSS(2))=0
SET CNT2=CNT2+1
Begin DoDot:1
+3 FOR
SET PSS(2)=$ORDER(PSS5115(51.153,PSS(2)))
if 'PSS(2)
QUIT
DO SETLOC
SET CNT=CNT+1
+4 SET ^TMP($JOB,LIST,PSSIEN,"HOSP",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:1
+5 SET ^TMP($JOB,LIST,0)=$SELECT($GET(CNT2)>0:CNT2,1:"-1^NO DATA FOUND")
+6 QUIT
