PSOORUT3 ;ISC-BHAM/SAB-build listman screen continued ;12/07/95 18:12
;;7.0;OUTPATIENT PHARMACY;**5,25,243**;DEC 1997;Build 22
;
;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
S PSOBM=$S(VALMMENU:19,1:21) 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
PSOORUT3 ;ISC-BHAM/SAB-build listman screen continued ;12/07/95 18:12
+1 ;;7.0;OUTPATIENT PHARMACY;**5,25,243**;DEC 1997;Build 22
+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
+1 SET PSOBM=$SELECT(VALMMENU:19,1:21)
IF VALM("BM")'=PSOBM
SET VALMBCK="R"
Begin DoDot:1
+2 SET VALM("BM")=PSOBM
SET VALM("LINES")=(PSOBM-VALM("TM"))+1
IF +$GET(VALMCC)
DO RESET^VALM4
End DoDot:1
+3 QUIT
