PSOORUT3 ;ISC-BHAM/SAB-build listman screen continued ;12/07/95 18:12
;;7.0;OUTPATIENT PHARMACY;**5,25,243,700**;DEC 1997;Build 261
;
;Reference to MAIN^TIUEDIT supported by IA# 2410
;Reference to RESET^VALM4 supported by IA# 2334
;bulids allergy/adverse reactions list
F DR=0:0 S DR=$O(GMRAL(DR)) Q:'DR S ^TMP($J,"AL",$S($P(GMRAL(DR),"^",4):1,1:2),$S('$P(GMRAL(DR),"^",5):1,1:2),$P(GMRAL(DR),"^",7),$P(GMRAL(DR),"^",2))=""
S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Allergies "
S:$O(^TMP($J,"AL",1,1,""))]"" IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" Verified: "
S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,1,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",1,1,TY,DR)) Q:DR="" D
.S:$L(^TMP("PSOPI",$J,IEN,0)_DR_", ")>80 IEN=IEN+1,$P(^TMP("PSOPI",$J,IEN,0)," ",14)=" " S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_DR_", "
S:$O(^TMP($J,"AL",2,1,""))]"" IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Non-Verified: "
S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,1,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",2,1,TY,DR)) Q:DR="" D
.S:$L(^TMP("PSOPI",$J,IEN,0)_DR_", ")>80 IEN=IEN+1,$P(^TMP("PSOPI",$J,IEN,0)," ",14)=" " S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_DR_", "
D REMOTE^PSOORUT2
S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "
S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Adverse Reactions "
S:$O(^TMP($J,"AL",1,2,""))]"" IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" Verified: "
S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,2,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",1,2,TY,DR)) Q:DR="" D
.S:$L(^TMP("PSOPI",$J,IEN,0)_DR_", ")>80 IEN=IEN+1,$P(^TMP("PSOPI",$J,IEN,0)," ",14)=" " S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_DR_", "
S:$O(^TMP($J,"AL",2,2,""))]"" IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Non-Verified: "
S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,2,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",2,2,TY,DR)) Q:DR="" D
.S:$L(^TMP("PSOPI",$J,IEN,0)_DR_", ")>80 IEN=IEN+1,$P(^TMP("PSOPI",$J,IEN,0)," ",15)=" " S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_DR_", "
K TY,D,I,GMRA,GMRAL,DR,AD,ADL,^TMP($J,"AL")
Q
PRONTE ;entry point to enter a progress note DBIA 220
I $T(MAIN^TIUEDIT)]"" D FULL^VALM1,MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1) Q
S VALMSG="Progress Notes NOT Available.",VALMBCK=""
Q
DPLYOR ;displays status of patient's orders
S PSOHA=1,(EXT,DTME,RX,OLDT)="",(CNT,CNT1,RXNYM)=0
S X=PSODFN,DIC=2,DIC(0)="ZN" D ^DIC K DIC S NAM=Y(0,0),NNUM=PSODFN
D BING^PSOBGMG3 S VALMBCK="R" K PSOHA
W ! S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR
K DIR,DIRUT,DTOUT,DUOUT
Q
A ;resizes list area (Called from PSO PENDING ORDER MENU - HEADER field)
S PSOBM=$S(VALMMENU:20,1:21) D RES
Q
B ;resizes list area (Called from PSO LM ACCEPT MENU - HEADER field)
S PSOBM=21 D RES
Q
RES ; Resize
; Some users use 48-line on their Terminal Emulator to strech Listman body
I $D(^%ZOSF("ZVX")) Q
;
I VALM("BM")'=PSOBM S VALMBCK="R" D
. S VALM("BM")=PSOBM,VALM("LINES")=(PSOBM-VALM("TM"))+1 I +$G(VALMCC) D RESET^VALM4
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORUT3 2995 printed Oct 16, 2024@18:33:04 Page 2
PSOORUT3 ;ISC-BHAM/SAB-build listman screen continued ;12/07/95 18:12
+1 ;;7.0;OUTPATIENT PHARMACY;**5,25,243,700**;DEC 1997;Build 261
+2 ;
+3 ;Reference to MAIN^TIUEDIT supported by IA# 2410
+4 ;Reference to RESET^VALM4 supported by IA# 2334
+5 ;bulids allergy/adverse reactions list
+6 FOR DR=0:0
SET DR=$ORDER(GMRAL(DR))
if 'DR
QUIT
SET ^TMP($JOB,"AL",$SELECT($PIECE(GMRAL(DR),"^",4):1,1:2),$SELECT('$PIECE(GMRAL(DR),"^",5):1,1:2),$PIECE(GMRAL(DR),"^",7),$PIECE(GMRAL(DR),"^",2))=""
+7 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Allergies "
+8 if $ORDER(^TMP($JOB,"AL",1,1,""))]""
SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)=" Verified: "
+9 SET (DR,TY)=""
FOR I=0:0
SET TY=$ORDER(^TMP($JOB,"AL",1,1,TY))
if TY=""
QUIT
FOR D=0:0
SET DR=$ORDER(^TMP($JOB,"AL",1,1,TY,DR))
if DR=""
QUIT
Begin DoDot:1
+10 if $LENGTH(^TMP("PSOPI",$JOB,IEN,0)_DR_", ")>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPI",$JOB,IEN,0)," ",14)=" "
SET ^TMP("PSOPI",$JOB,IEN,0)=$GET(^TMP("PSOPI",$JOB,IEN,0))_DR_", "
End DoDot:1
+11 if $ORDER(^TMP($JOB,"AL",2,1,""))]""
SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Non-Verified: "
+12 SET (DR,TY)=""
FOR I=0:0
SET TY=$ORDER(^TMP($JOB,"AL",2,1,TY))
if TY=""
QUIT
FOR D=0:0
SET DR=$ORDER(^TMP($JOB,"AL",2,1,TY,DR))
if DR=""
QUIT
Begin DoDot:1
+13 if $LENGTH(^TMP("PSOPI",$JOB,IEN,0)_DR_", ")>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPI",$JOB,IEN,0)," ",14)=" "
SET ^TMP("PSOPI",$JOB,IEN,0)=$GET(^TMP("PSOPI",$JOB,IEN,0))_DR_", "
End DoDot:1
+14 DO REMOTE^PSOORUT2
+15 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)=" "
+16 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Adverse Reactions "
+17 if $ORDER(^TMP($JOB,"AL",1,2,""))]""
SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)=" Verified: "
+18 SET (DR,TY)=""
FOR I=0:0
SET TY=$ORDER(^TMP($JOB,"AL",1,2,TY))
if TY=""
QUIT
FOR D=0:0
SET DR=$ORDER(^TMP($JOB,"AL",1,2,TY,DR))
if DR=""
QUIT
Begin DoDot:1
+19 if $LENGTH(^TMP("PSOPI",$JOB,IEN,0)_DR_", ")>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPI",$JOB,IEN,0)," ",14)=" "
SET ^TMP("PSOPI",$JOB,IEN,0)=$GET(^TMP("PSOPI",$JOB,IEN,0))_DR_", "
End DoDot:1
+20 if $ORDER(^TMP($JOB,"AL",2,2,""))]""
SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Non-Verified: "
+21 SET (DR,TY)=""
FOR I=0:0
SET TY=$ORDER(^TMP($JOB,"AL",2,2,TY))
if TY=""
QUIT
FOR D=0:0
SET DR=$ORDER(^TMP($JOB,"AL",2,2,TY,DR))
if DR=""
QUIT
Begin DoDot:1
+22 if $LENGTH(^TMP("PSOPI",$JOB,IEN,0)_DR_", ")>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPI",$JOB,IEN,0)," ",15)=" "
SET ^TMP("PSOPI",$JOB,IEN,0)=$GET(^TMP("PSOPI",$JOB,IEN,0))_DR_", "
End DoDot:1
+23 KILL TY,D,I,GMRA,GMRAL,DR,AD,ADL,^TMP($JOB,"AL")
+24 QUIT
PRONTE ;entry point to enter a progress note DBIA 220
+1 IF $TEXT(MAIN^TIUEDIT)]""
DO FULL^VALM1
DO MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1)
QUIT
+2 SET VALMSG="Progress Notes NOT Available."
SET VALMBCK=""
+3 QUIT
DPLYOR ;displays status of patient's orders
+1 SET PSOHA=1
SET (EXT,DTME,RX,OLDT)=""
SET (CNT,CNT1,RXNYM)=0
+2 SET X=PSODFN
SET DIC=2
SET DIC(0)="ZN"
DO ^DIC
KILL DIC
SET NAM=Y(0,0)
SET NNUM=PSODFN
+3 DO BING^PSOBGMG3
SET VALMBCK="R"
KILL PSOHA
+4 WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
+5 KILL DIR,DIRUT,DTOUT,DUOUT
+6 QUIT
A ;resizes list area (Called from PSO PENDING ORDER MENU - HEADER field)
+1 SET PSOBM=$SELECT(VALMMENU:20,1:21)
DO RES
+2 QUIT
B ;resizes list area (Called from PSO LM ACCEPT MENU - HEADER field)
+1 SET PSOBM=21
DO RES
+2 QUIT
RES ; Resize
+1 ; Some users use 48-line on their Terminal Emulator to strech Listman body
+2 IF $DATA(^%ZOSF("ZVX"))
QUIT
+3 ;
+4 IF VALM("BM")'=PSOBM
SET VALMBCK="R"
Begin DoDot:1
+5 SET VALM("BM")=PSOBM
SET VALM("LINES")=(PSOBM-VALM("TM"))+1
IF +$GET(VALMCC)
DO RESET^VALM4
End DoDot:1
+6 QUIT
