PSJ53P1 ;BIR/DB - API FOR INFORMATION FROM FILE 53.1; 5 Sep 03
;;5.0; INPATIENT MEDICATIONS ;**172**;16 DEC 97;Build 13
PSJ(PSJIEN,LIST) ;
;PSJIEN - INTERNAL ENTRY NUMBER [REQUIRED]
;LIST: Subscript name used in ^TMP global [REQUIRED]
I $G(PSJIEN)="" Q
I $G(LIST)="" Q
K ^TMP($J,LIST),DA,^UTILITY("DIQ1",$J),DIQ
I $G(PSJIEN)]"" S DA=PSJIEN I '$D(^PS(53.1,DA,0)) G RET0
K ^UTILITY("DIQ1",$J),DIC S DIC=53.1,DR=".01;1;3;7;10;25;26;28;108;109",DIQ(0)="IE" D EN^DIQ1
I '$D(^UTILITY("DIQ1",$J)) G RET0
S ^TMP($J,LIST,0)=1,PSJDA=DA
S PSJTXT=^UTILITY("DIQ1",$J,53.1,DA,.01,"E")
F X=.01,1,3,7,10,26,28,25,108,109 S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,53.1,DA,X,"I"))
F X=1,3,7,10,28,25,108 S ^TMP($J,LIST,DA,X)=$S($G(^UTILITY("DIQ1",$J,53.1,DA,X,"E"))'="":^TMP($J,LIST,DA,X)_"^"_$G(^UTILITY("DIQ1",$J,53.1,DA,X,"E")),1:"")
S ^TMP($J,LIST,"B",PSJTXT,DA)=""
S PSJDRG=0 F S PSJDRG=$O(^PS(53.1,PSJDA,1,PSJDRG)) Q:PSJDRG'>0 D
.S DA=PSJDA,DIC=53.1,DR=2,DR(53.11)=".01;.02",DIQ(0)="IE",DA(53.11)=PSJDRG D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J))
.S ^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.01,"I"))
.S ^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.02)=$G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.02,"I"))
.S ^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$S($G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.01,"E"))'="":^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.01)_"^"_$G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.01,"E")),1:"")
.S ^TMP($J,LIST,PSJDA,"DDRUG",0)=$G(^TMP($J,LIST,PSJDA,"DDRUG",0))+1
I '$D(^TMP($J,LIST,PSJDA,"DDRUG",0)) S ^TMP($J,LIST,PSJDA,"DDRUG",0)="-1^NO DATA FOUND"
K PSJIEN,DA,X,PSJTXT,DR,DIC,^UTILITY("DIQ1",$J),DIQ,PSJDA,PSJDRG
Q
RET0 ;return no data
K PSJIEN,PSJTXT S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
PSJ53P1 ;BIR/DB - API FOR INFORMATION FROM FILE 53.1; 5 Sep 03
+1 ;;5.0; INPATIENT MEDICATIONS ;**172**;16 DEC 97;Build 13
PSJ(PSJIEN,LIST) ;
+1 ;PSJIEN - INTERNAL ENTRY NUMBER [REQUIRED]
+2 ;LIST: Subscript name used in ^TMP global [REQUIRED]
+3 IF $GET(PSJIEN)=""
QUIT
+4 IF $GET(LIST)=""
QUIT
+5 KILL ^TMP($JOB,LIST),DA,^UTILITY("DIQ1",$JOB),DIQ
+6 IF $GET(PSJIEN)]""
SET DA=PSJIEN
IF '$DATA(^PS(53.1,DA,0))
GOTO RET0
+7 KILL ^UTILITY("DIQ1",$JOB),DIC
SET DIC=53.1
SET DR=".01;1;3;7;10;25;26;28;108;109"
SET DIQ(0)="IE"
DO EN^DIQ1
+8 IF '$DATA(^UTILITY("DIQ1",$JOB))
GOTO RET0
+9 SET ^TMP($JOB,LIST,0)=1
SET PSJDA=DA
+10 SET PSJTXT=^UTILITY("DIQ1",$JOB,53.1,DA,.01,"E")
+11 FOR X=.01,1,3,7,10,26,28,25,108,109
SET ^TMP($JOB,LIST,DA,X)=$GET(^UTILITY("DIQ1",$JOB,53.1,DA,X,"I"))
+12 FOR X=1,3,7,10,28,25,108
SET ^TMP($JOB,LIST,DA,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,53.1,DA,X,"E"))'="":^TMP($JOB,LIST,DA,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,53.1,DA,X,"E")),1:"")
+13 SET ^TMP($JOB,LIST,"B",PSJTXT,DA)=""
+14 SET PSJDRG=0
FOR
SET PSJDRG=$ORDER(^PS(53.1,PSJDA,1,PSJDRG))
IF PSJDRG'>0
QUIT
Begin DoDot:1
+15 SET DA=PSJDA
SET DIC=53.1
SET DR=2
SET DR(53.11)=".01;.02"
SET DIQ(0)="IE"
SET DA(53.11)=PSJDRG
DO EN^DIQ1
IF '$DATA(^UTILITY("DIQ1",$JOB))
QUIT
+16 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.01,"I"))
+17 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.02)=$GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.02,"I"))
+18 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$SELECT($GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.01,"E"))'="":^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.01)_"^"_$GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.01,"E")),1:"")
+19 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",0)=$GET(^TMP($JOB,LIST,PSJDA,"DDRUG",0))+1
End DoDot:1
+20 IF '$DATA(^TMP($JOB,LIST,PSJDA,"DDRUG",0))
SET ^TMP($JOB,LIST,PSJDA,"DDRUG",0)="-1^NO DATA FOUND"
+21 KILL PSJIEN,DA,X,PSJTXT,DR,DIC,^UTILITY("DIQ1",$JOB),DIQ,PSJDA,PSJDRG
+22 QUIT
RET0 ;return no data
+1 KILL PSJIEN,PSJTXT
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
QUIT