- 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 Jan 18, 2025@03:33:34 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