PSJ59P5 ;BIR/LDT,TSS - API FOR INFORMATION FROM FILE 59.5; 5 Sep 03
;;5.0; INPATIENT MEDICATIONS ;**163,172**;16 DEC 97;Build 13
;
;Reference to ^DG(40.8 - DBIA 2269
;
ALL(PSJIEN,PSJFT,LIST) ;
;PSJIEN - IEN of entry in 59.5.
;PSJFT - Free Text name in 59.5 or "??" for all names
;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), DIVISION field (#.02), and INACTIVATION DATE field (#19) of IV ROOM file (#59.5).
N DIERR,ZZERR,PSJ59P5,SCR,PSJ,PSJIEN2
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSJIEN)'>0,($G(PSJFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSJIEN)]"",+$G(PSJIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I +$G(PSJIEN)>0 S PSJIEN2=$$FIND1^DIC(59.5,"","A","`"_PSJIEN,,,"") D
.I +PSJIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(59.5,+PSJIEN2,".01;.02;19","IE","PSJ59P5") S PSJ(1)=0
.F S PSJ(1)=$O(PSJ59P5(59.5,PSJ(1))) Q:'PSJ(1) D SETALL
I +$G(PSJIEN)'>0,$G(PSJFT)="??" D Q
.D LOOPDIR
I +$G(PSJIEN)'>0,$G(PSJFT)]"" D
.D FIND^DIC(59.5,,"@;.01;","QP",PSJFT,,"B",,,"")
.I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSJXLP S PSJXLP=0 F S PSJXLP=$O(^TMP("DILIST",$J,PSJXLP)) Q:'PSJXLP D
..S PSJIEN=+^TMP("DILIST",$J,PSJXLP,0) K PSJ59P5 D GETS^DIQ(59.5,+PSJIEN,".01;.02;19","IE","PSJ59P5") S PSJ(1)=0
..F S PSJ(1)=$O(PSJ59P5(59.5,PSJ(1))) Q:'PSJ(1) D SETALL
K ^TMP("DILIST",$J)
Q
;
LOOPDIR ;LOOP FOR A DIRECT READ.
N PSJCNT S PSJCNT=0
S PSJIEN2=0
F S PSJIEN2=$O(^PS(59.5,PSJIEN2)) Q:'PSJIEN2 D
.D SETDIR
D COUNT
Q
;
SETALL ;
S ^TMP($J,LIST,+PSJ(1),.01)=$G(PSJ59P5(59.5,PSJ(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSJ59P5(59.5,PSJ(1),.01,"I")),+PSJ(1))=""
S ^TMP($J,LIST,+PSJ(1),.02)=$S($G(PSJ59P5(59.5,PSJ(1),.02,"I"))="":"",1:PSJ59P5(59.5,PSJ(1),.02,"I")_"^"_PSJ59P5(59.5,PSJ(1),.02,"E"))
S ^TMP($J,LIST,+PSJ(1),19)=$S($G(PSJ59P5(59.5,PSJ(1),19,"I"))="":"",1:PSJ59P5(59.5,PSJ(1),19,"I")_"^"_PSJ59P5(59.5,PSJ(1),19,"E"))
Q
;
SETDIR ;
S ^TMP($J,LIST,+PSJIEN2,.01)=$P($G(^PS(59.5,PSJIEN2,0)),U,1)
S ^TMP($J,LIST,"B",$P($G(^PS(59.5,PSJIEN2,0)),U,1),+PSJIEN2)=""
S ^TMP($J,LIST,+PSJIEN2,.02)=$S($P($G(^PS(59.5,PSJIEN2,0)),U,4)="":"",1:$P($G(^PS(59.5,PSJIEN2,0)),U,4)_"^"_$P($G(^DG(40.8,$P($G(^PS(59.5,PSJIEN2,0)),U,4),0)),U,1))
S ^TMP($J,LIST,+PSJIEN2,19)=$S($P($G(^PS(59.5,PSJIEN2,"I")),U,1)="":"",1:$P($G(^PS(59.5,PSJIEN2,"I")),U,1)_"^"_$$GETDATE($P($G(^PS(59.5,PSJIEN2,"I")),U,1)))
S PSJCNT=PSJCNT+1
Q
;
GETDATE(PSJDATE) ;RETURNS FORMATTED DATE
N Y S Y=PSJDATE X ^DD("DD")
Q $G(Y)
;
WRT(PSJDFN,PSJVAL,LIST) ;Sets Division field
;PSJDFN = IV ROOM (REQUIRED)
;PSJVAL = Division (REQUIRED)
;LIST: Subscript name used in ^TMP global [REQUIRED]
I $G(PSJDFN)'>0 Q
I $G(PSJVAL)="" Q
I $G(LIST)="" Q
I '$D(^PS(59.5,PSJDFN)) S ^TMP($J,LIST,0)=0 Q
I $G(PSJVAL)'>0 S ^TMP($J,LIST,0)=0 Q
I '$D(^DG(40.8,PSJVAL,0)) S ^TMP($J,LIST,0)=0 Q
S $P(^PS(59.5,PSJDFN,0),"^",4)=PSJVAL,^TMP($J,LIST,0)=1 K PSJVAL,PSJDFN Q
COUNT ;
I PSJCNT>0 S ^TMP($J,LIST,0)=PSJCNT
ELSE S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ59P5 3319 printed Apr 09, 2024@21:05:21 Page 2
PSJ59P5 ;BIR/LDT,TSS - API FOR INFORMATION FROM FILE 59.5; 5 Sep 03
+1 ;;5.0; INPATIENT MEDICATIONS ;**163,172**;16 DEC 97;Build 13
+2 ;
+3 ;Reference to ^DG(40.8 - DBIA 2269
+4 ;
ALL(PSJIEN,PSJFT,LIST) ;
+1 ;PSJIEN - IEN of entry in 59.5.
+2 ;PSJFT - Free Text name in 59.5 or "??" for all names
+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), DIVISION field (#.02), and INACTIVATION DATE field (#19) of IV ROOM file (#59.5).
+6 NEW DIERR,ZZERR,PSJ59P5,SCR,PSJ,PSJIEN2
+7 IF $GET(LIST)']""
QUIT
+8 KILL ^TMP($JOB,LIST)
+9 IF +$GET(PSJIEN)'>0
IF ($GET(PSJFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 IF $GET(PSJIEN)]""
IF +$GET(PSJIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 IF +$GET(PSJIEN)>0
SET PSJIEN2=$$FIND1^DIC(59.5,"","A","`"_PSJIEN,,,"")
Begin DoDot:1
+12 IF +PSJIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 SET ^TMP($JOB,LIST,0)=1
+14 DO GETS^DIQ(59.5,+PSJIEN2,".01;.02;19","IE","PSJ59P5")
SET PSJ(1)=0
+15 FOR
SET PSJ(1)=$ORDER(PSJ59P5(59.5,PSJ(1)))
if 'PSJ(1)
QUIT
DO SETALL
End DoDot:1
+16 IF +$GET(PSJIEN)'>0
IF $GET(PSJFT)="??"
Begin DoDot:1
+17 DO LOOPDIR
End DoDot:1
QUIT
+18 IF +$GET(PSJIEN)'>0
IF $GET(PSJFT)]""
Begin DoDot:1
+19 DO FIND^DIC(59.5,,"@;.01;","QP",PSJFT,,"B",,,"")
+20 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+21 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSJXLP
SET PSJXLP=0
FOR
SET PSJXLP=$ORDER(^TMP("DILIST",$JOB,PSJXLP))
if 'PSJXLP
QUIT
Begin DoDot:2
+22 SET PSJIEN=+^TMP("DILIST",$JOB,PSJXLP,0)
KILL PSJ59P5
DO GETS^DIQ(59.5,+PSJIEN,".01;.02;19","IE","PSJ59P5")
SET PSJ(1)=0
+23 FOR
SET PSJ(1)=$ORDER(PSJ59P5(59.5,PSJ(1)))
if 'PSJ(1)
QUIT
DO SETALL
End DoDot:2
End DoDot:1
+24 KILL ^TMP("DILIST",$JOB)
+25 QUIT
+26 ;
LOOPDIR ;LOOP FOR A DIRECT READ.
+1 NEW PSJCNT
SET PSJCNT=0
+2 SET PSJIEN2=0
+3 FOR
SET PSJIEN2=$ORDER(^PS(59.5,PSJIEN2))
if 'PSJIEN2
QUIT
Begin DoDot:1
+4 DO SETDIR
End DoDot:1
+5 DO COUNT
+6 QUIT
+7 ;
SETALL ;
+1 SET ^TMP($JOB,LIST,+PSJ(1),.01)=$GET(PSJ59P5(59.5,PSJ(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSJ59P5(59.5,PSJ(1),.01,"I")),+PSJ(1))=""
+3 SET ^TMP($JOB,LIST,+PSJ(1),.02)=$SELECT($GET(PSJ59P5(59.5,PSJ(1),.02,"I"))="":"",1:PSJ59P5(59.5,PSJ(1),.02,"I")_"^"_PSJ59P5(59.5,PSJ(1),.02,"E"))
+4 SET ^TMP($JOB,LIST,+PSJ(1),19)=$SELECT($GET(PSJ59P5(59.5,PSJ(1),19,"I"))="":"",1:PSJ59P5(59.5,PSJ(1),19,"I")_"^"_PSJ59P5(59.5,PSJ(1),19,"E"))
+5 QUIT
+6 ;
SETDIR ;
+1 SET ^TMP($JOB,LIST,+PSJIEN2,.01)=$PIECE($GET(^PS(59.5,PSJIEN2,0)),U,1)
+2 SET ^TMP($JOB,LIST,"B",$PIECE($GET(^PS(59.5,PSJIEN2,0)),U,1),+PSJIEN2)=""
+3 SET ^TMP($JOB,LIST,+PSJIEN2,.02)=$SELECT($PIECE($GET(^PS(59.5,PSJIEN2,0)),U,4)="":"",1:$PIECE($GET(^PS(59.5,PSJIEN2,0)),U,4)_"^"_$PIECE($GET(^DG(40.8,$PIECE($GET(^PS(59.5,PSJIEN2,0)),U,4),0)),U,1))
+4 SET ^TMP($JOB,LIST,+PSJIEN2,19)=$SELECT($PIECE($GET(^PS(59.5,PSJIEN2,"I")),U,1)="":"",1:$PIECE($GET(^PS(59.5,PSJIEN2,"I")),U,1)_"^"_$$GETDATE($PIECE($GET(^PS(59.5,PSJIEN2,"I")),U,1)))
+5 SET PSJCNT=PSJCNT+1
+6 QUIT
+7 ;
GETDATE(PSJDATE) ;RETURNS FORMATTED DATE
+1 NEW Y
SET Y=PSJDATE
XECUTE ^DD("DD")
+2 QUIT $GET(Y)
+3 ;
WRT(PSJDFN,PSJVAL,LIST) ;Sets Division field
+1 ;PSJDFN = IV ROOM (REQUIRED)
+2 ;PSJVAL = Division (REQUIRED)
+3 ;LIST: Subscript name used in ^TMP global [REQUIRED]
+4 IF $GET(PSJDFN)'>0
QUIT
+5 IF $GET(PSJVAL)=""
QUIT
+6 IF $GET(LIST)=""
QUIT
+7 IF '$DATA(^PS(59.5,PSJDFN))
SET ^TMP($JOB,LIST,0)=0
QUIT
+8 IF $GET(PSJVAL)'>0
SET ^TMP($JOB,LIST,0)=0
QUIT
+9 IF '$DATA(^DG(40.8,PSJVAL,0))
SET ^TMP($JOB,LIST,0)=0
QUIT
+10 SET $PIECE(^PS(59.5,PSJDFN,0),"^",4)=PSJVAL
SET ^TMP($JOB,LIST,0)=1
KILL PSJVAL,PSJDFN
QUIT
COUNT ;
+1 IF PSJCNT>0
SET ^TMP($JOB,LIST,0)=PSJCNT
+2 IF '$TEST
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
+3 QUIT
+4 ;
