- 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 Mar 13, 2025@21:34:43 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
