- 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 Feb 18, 2025@23:32: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 ;