- PSJLMUT2 ;BIR/JLC-DISPLAY UTILITIES ;22 Jun 05
- ;;5.0; INPATIENT MEDICATIONS ;**146,175,201**;16 DEC 97;Build 2
- ;
- SHOR(PSJT,PSJI) ;Display outpatient remote order checks.
- ;; PSJT = Type of order check in ^TMP
- ;; PSJI = Index to ^TMP to find order check detail
- ;
- N PSJD0,PSJD1,PSJRX,PSJRS,FSIG,PSJULN,PSJLF,PSJDN
- S PSJD0=^TMP($J,PSJT,PSJI,0),PSJD1=^(1)
- I PSJT="DD" S PSJRX=$P($P(PSJD0,"^",4),";"),PSJRS=$P(PSJD0,"^",5),PSJDN=$P(PSJD0,"^",2)
- I PSJT="DC" S PSJRX=$P($P(PSJD0,"^",6),";"),PSJRS=$P(PSJD0,"^",7),PSJDN=$P(PSJD0,"^",4)
- I PSJT="DI" S PSJRX=$P($P(PSJD0,"^",8),";"),PSJRS=$P(PSJD0,"^",9),PSJDN=$P(PSJD0,"^",2)
- S PSJLF=$P(PSJD1,"^",3),$P(PSJULN,"-",79)=""
- W !,PSJULN,!
- W PSJRS I $L(PSJRS)>13 W !
- W ?14,"Rx #: ",$E(PSJRX,1,$L(PSJRX)-1) I $A($L(PSJRX))<54 W $E(PSJRX,$L(PSJRX))
- W ?39,PSJDN,! I PSJT="DI" W ?39,$P(PSJD0,"^",4)," INTERACTION",!
- W $J("Status: ",20),$P(PSJD1,"^",2),?40,$J("Issued: ",20),$P(PSJD1,"^",9)
- D FSIG(.FSIG)
- W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
- W $J("QTY: ",20)_$P(PSJD1,"^",5)
- W !,$J("Provider: ",20),$P(PSJD1,"^",8),?40,$J("Refills remaining: ",20),$P(PSJD1,"^",6)
- W !?40,$J("Last filled on: ",20),PSJLF
- W !?40,$J("Days Supply: ",20)_$P(PSJD1,"^",4)
- W !,PSJULN
- Q
- FSIG(FSIG) ;Format sig from remote site
- ;returned in the FSIG array
- N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
- F I=0:1 Q:'$D(^TMP($J,PSJT,PSJI,1,I)) S HSIG(I+1)=^(I)
- FSTART S (FVAR,FVAR1)="",II=1
- F FFF=0:0 S FFF=$O(HSIG(FFF)) Q:'FFF S CNT=0 F NNN=1:1:$L(HSIG(FFF)) I $E(HSIG(FFF),NNN)=" "!($L(HSIG(FFF))=NNN) S CNT=CNT+1 D I $L(FVAR)>52 S FSIG(II)=FLIM_" ",II=II+1,FVAR=FVAR1
- .S FVAR1=$P(HSIG(FFF)," ",(CNT))
- .S FLIM=FVAR
- .S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
- I $G(FVAR)'="" S FSIG(II)=FVAR
- I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2)
- FQUIT Q
- PAUSE ;
- K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W !
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLMUT2 1949 printed Jan 18, 2025@03:08:47 Page 2
- PSJLMUT2 ;BIR/JLC-DISPLAY UTILITIES ;22 Jun 05
- +1 ;;5.0; INPATIENT MEDICATIONS ;**146,175,201**;16 DEC 97;Build 2
- +2 ;
- SHOR(PSJT,PSJI) ;Display outpatient remote order checks.
- +1 ;; PSJT = Type of order check in ^TMP
- +2 ;; PSJI = Index to ^TMP to find order check detail
- +3 ;
- +4 NEW PSJD0,PSJD1,PSJRX,PSJRS,FSIG,PSJULN,PSJLF,PSJDN
- +5 SET PSJD0=^TMP($JOB,PSJT,PSJI,0)
- SET PSJD1=^(1)
- +6 IF PSJT="DD"
- SET PSJRX=$PIECE($PIECE(PSJD0,"^",4),";")
- SET PSJRS=$PIECE(PSJD0,"^",5)
- SET PSJDN=$PIECE(PSJD0,"^",2)
- +7 IF PSJT="DC"
- SET PSJRX=$PIECE($PIECE(PSJD0,"^",6),";")
- SET PSJRS=$PIECE(PSJD0,"^",7)
- SET PSJDN=$PIECE(PSJD0,"^",4)
- +8 IF PSJT="DI"
- SET PSJRX=$PIECE($PIECE(PSJD0,"^",8),";")
- SET PSJRS=$PIECE(PSJD0,"^",9)
- SET PSJDN=$PIECE(PSJD0,"^",2)
- +9 SET PSJLF=$PIECE(PSJD1,"^",3)
- SET $PIECE(PSJULN,"-",79)=""
- +10 WRITE !,PSJULN,!
- +11 WRITE PSJRS
- IF $LENGTH(PSJRS)>13
- WRITE !
- +12 WRITE ?14,"Rx #: ",$EXTRACT(PSJRX,1,$LENGTH(PSJRX)-1)
- IF $ASCII($LENGTH(PSJRX))<54
- WRITE $EXTRACT(PSJRX,$LENGTH(PSJRX))
- +13 WRITE ?39,PSJDN,!
- IF PSJT="DI"
- WRITE ?39,$PIECE(PSJD0,"^",4)," INTERACTION",!
- +14 WRITE $JUSTIFY("Status: ",20),$PIECE(PSJD1,"^",2),?40,$JUSTIFY("Issued: ",20),$PIECE(PSJD1,"^",9)
- +15 DO FSIG(.FSIG)
- +16 WRITE !,$JUSTIFY("SIG: ",20)
- FOR I=1:1
- if '$DATA(FSIG(I))
- QUIT
- WRITE ?20,FSIG(I),!
- +17 WRITE $JUSTIFY("QTY: ",20)_$PIECE(PSJD1,"^",5)
- +18 WRITE !,$JUSTIFY("Provider: ",20),$PIECE(PSJD1,"^",8),?40,$JUSTIFY("Refills remaining: ",20),$PIECE(PSJD1,"^",6)
- +19 WRITE !?40,$JUSTIFY("Last filled on: ",20),PSJLF
- +20 WRITE !?40,$JUSTIFY("Days Supply: ",20)_$PIECE(PSJD1,"^",4)
- +21 WRITE !,PSJULN
- +22 QUIT
- FSIG(FSIG) ;Format sig from remote site
- +1 ;returned in the FSIG array
- +2 NEW FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
- +3 FOR I=0:1
- if '$DATA(^TMP($JOB,PSJT,PSJI,1,I))
- QUIT
- SET HSIG(I+1)=^(I)
- FSTART SET (FVAR,FVAR1)=""
- SET II=1
- +1 FOR FFF=0:0
- SET FFF=$ORDER(HSIG(FFF))
- if 'FFF
- QUIT
- SET CNT=0
- FOR NNN=1:1:$LENGTH(HSIG(FFF))
- IF $EXTRACT(HSIG(FFF),NNN)=" "!($LENGTH(HSIG(FFF))=NNN)
- SET CNT=CNT+1
- Begin DoDot:1
- +2 SET FVAR1=$PIECE(HSIG(FFF)," ",(CNT))
- +3 SET FLIM=FVAR
- +4 SET FVAR=$SELECT(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
- End DoDot:1
- IF $LENGTH(FVAR)>52
- SET FSIG(II)=FLIM_" "
- SET II=II+1
- SET FVAR=FVAR1
- +5 IF $GET(FVAR)'=""
- SET FSIG(II)=FVAR
- +6 IF $GET(FSIG(1))=""!($GET(FSIG(1))=" ")
- SET FSIG(1)=$GET(FSIG(2))
- KILL FSIG(2)
- FQUIT QUIT
- PAUSE ;
- +1 KILL DIR
- WRITE !
- SET DIR(0)="EA"
- SET DIR("A")="Press Return to continue..."
- DO ^DIR
- WRITE !
- +2 QUIT