PSS54 ;BIR/LDT - API FOR INFORMATION FROM FILE 54; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;
ALL(PSSIEN,PSSFT,LIST) ;
;PSSIEN - IEN of entry in RX CONSULT file (#54).
;PSSFT - Free Text name in RX CONSULT file (#54).
;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) and TEXT field (#1) of RX CONSULT file (#54).
N DIERR,ZZERR,PSS54,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)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(54,"","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(54,+PSSIEN2,".01;1*","I","PSS54") S PSS(1)=0
.F S PSS(1)=$O(PSS54(54,PSS(1))) Q:'PSS(1) D SETZRO S PSS(2)=0,^TMP($J,LIST,+PSSIEN,"TXT",0)=0 D
..F S PSS(2)=$O(PSS54(54.1,PSS(2))) Q:'PSS(2) S ^TMP($J,LIST,+PSSIEN,"TXT",0)=^TMP($J,LIST,+PSSIEN,"TXT",0)+1 D SETTXT
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP Q
.D FIND^DIC(54,,"@;.01","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 PSS54 D GETS^DIQ(54,+PSSIEN,".01;1*","I","PSS54") S PSS(1)=0
..F S PSS(1)=$O(PSS54(54,PSS(1))) Q:'PSS(1) D SETZRO S PSS(2)=0,^TMP($J,LIST,+PSSIEN,"TXT",0)=0 D
...F S PSS(2)=$O(PSS54(54.1,PSS(2))) Q:'PSS(2) S ^TMP($J,LIST,+PSSIEN,"TXT",0)=^TMP($J,LIST,+PSSIEN,"TXT",0)+1 D SETTXT
K ^TMP("DILIST",$J)
Q
;
LOOKUP(PSSSRCH,LIST) ;
;PSSSRCH - IEN of entry in RX CONSULT file (#54).
;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) of RX CONSULT file (#54).
N DIERR,ZZERR
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I $G(PSSSRCH)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
D FIND^DIC(54,,"@;.01;","QP",PSSSRCH,,"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 ^TMP($J,LIST,+^TMP("DILIST",$J,PSSXX,0),.01)=$P($G(^TMP("DILIST",$J,PSSXX,0)),U,2)
.S ^TMP($J,LIST,"B",$P($G(^TMP("DILIST",$J,PSSXX,0)),U,2),+^TMP("DILIST",$J,PSSXX,0))=""
K ^TMP("DILIST",$J)
Q
;
SETZRO ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS54(54,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSS54(54,PSS(1),.01,"I")),+PSS(1))=""
Q
;
SETTXT ;
S ^TMP($J,LIST,+PSSIEN,"TXT",+PSS(2),.01)=$G(PSS54(54.1,PSS(2),.01,"I"))
Q
;
LOOP ;
N PSSIEN,CNT
S (PSSIEN,CNT)=0 F S PSSIEN=$O(^PS(54,PSSIEN)) Q:'PSSIEN D
.K PSS54 D GETS^DIQ(54,+PSSIEN,".01;1*","I","PSS54") S PSS(1)=0,CNT=CNT+1
.F S PSS(1)=$O(PSS54(54,PSS(1))) Q:'PSS(1) D SETZRO S PSS(2)=0,^TMP($J,LIST,+PSSIEN,"TXT",0)=0 D
..F S PSS(2)=$O(PSS54(54.1,PSS(2))) Q:'PSS(2) S ^TMP($J,LIST,+PSSIEN,"TXT",0)=^TMP($J,LIST,+PSSIEN,"TXT",0)+1 D SETTXT
S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS54 3309 printed Apr 09, 2024@21:32:29 Page 2
PSS54 ;BIR/LDT - API FOR INFORMATION FROM FILE 54; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;
ALL(PSSIEN,PSSFT,LIST) ;
+1 ;PSSIEN - IEN of entry in RX CONSULT file (#54).
+2 ;PSSFT - Free Text name in RX CONSULT file (#54).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+4 ; Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01) and TEXT field (#1) of RX CONSULT file (#54).
+6 NEW DIERR,ZZERR,PSS54,PSS
+7 IF $GET(LIST)']""
QUIT
+8 KILL ^TMP($JOB,LIST)
+9 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(54,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+12 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 SET ^TMP($JOB,LIST,0)=1
+14 DO GETS^DIQ(54,+PSSIEN2,".01;1*","I","PSS54")
SET PSS(1)=0
+15 FOR
SET PSS(1)=$ORDER(PSS54(54,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO
SET PSS(2)=0
SET ^TMP($JOB,LIST,+PSSIEN,"TXT",0)=0
Begin DoDot:2
+16 FOR
SET PSS(2)=$ORDER(PSS54(54.1,PSS(2)))
if 'PSS(2)
QUIT
SET ^TMP($JOB,LIST,+PSSIEN,"TXT",0)=^TMP($JOB,LIST,+PSSIEN,"TXT",0)+1
DO SETTXT
End DoDot:2
End DoDot:1
+17 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+18 IF PSSFT["??"
DO LOOP
QUIT
+19 DO FIND^DIC(54,,"@;.01","QP",PSSFT,,"B",,,"")
+20 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+21 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
+22 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS54
DO GETS^DIQ(54,+PSSIEN,".01;1*","I","PSS54")
SET PSS(1)=0
+23 FOR
SET PSS(1)=$ORDER(PSS54(54,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO
SET PSS(2)=0
SET ^TMP($JOB,LIST,+PSSIEN,"TXT",0)=0
Begin DoDot:3
+24 FOR
SET PSS(2)=$ORDER(PSS54(54.1,PSS(2)))
if 'PSS(2)
QUIT
SET ^TMP($JOB,LIST,+PSSIEN,"TXT",0)=^TMP($JOB,LIST,+PSSIEN,"TXT",0)+1
DO SETTXT
End DoDot:3
End DoDot:2
End DoDot:1
+25 KILL ^TMP("DILIST",$JOB)
+26 QUIT
+27 ;
LOOKUP(PSSSRCH,LIST) ;
+1 ;PSSSRCH - IEN of entry in RX CONSULT file (#54).
+2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+3 ; Field Number of the data piece being returned.
+4 ;Returns NAME field (#.01) of RX CONSULT file (#54).
+5 NEW DIERR,ZZERR
+6 IF $GET(LIST)']""
QUIT
+7 KILL ^TMP($JOB,LIST)
+8 IF $GET(PSSSRCH)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+9 DO FIND^DIC(54,,"@;.01;","QP",PSSSRCH,,"B",,,"")
+10 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 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:1
+12 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSSXX,0),.01)=$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),U,2)
+13 SET ^TMP($JOB,LIST,"B",$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),U,2),+^TMP("DILIST",$JOB,PSSXX,0))=""
End DoDot:1
+14 KILL ^TMP("DILIST",$JOB)
+15 QUIT
+16 ;
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS54(54,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSS54(54,PSS(1),.01,"I")),+PSS(1))=""
+3 QUIT
+4 ;
SETTXT ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"TXT",+PSS(2),.01)=$GET(PSS54(54.1,PSS(2),.01,"I"))
+2 QUIT
+3 ;
LOOP ;
+1 NEW PSSIEN,CNT
+2 SET (PSSIEN,CNT)=0
FOR
SET PSSIEN=$ORDER(^PS(54,PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+3 KILL PSS54
DO GETS^DIQ(54,+PSSIEN,".01;1*","I","PSS54")
SET PSS(1)=0
SET CNT=CNT+1
+4 FOR
SET PSS(1)=$ORDER(PSS54(54,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO
SET PSS(2)=0
SET ^TMP($JOB,LIST,+PSSIEN,"TXT",0)=0
Begin DoDot:2
+5 FOR
SET PSS(2)=$ORDER(PSS54(54.1,PSS(2)))
if 'PSS(2)
QUIT
SET ^TMP($JOB,LIST,+PSSIEN,"TXT",0)=^TMP($JOB,LIST,+PSSIEN,"TXT",0)+1
DO SETTXT
End DoDot:2
End DoDot:1
+6 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+7 QUIT
