Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMCFPRN

BMCFPRN.m

Go to the documentation of this file. 
  1. BMCFPRN ; IHS/OIT/FCJ - PRINT REFERRAL FORMS ;   [ 09/27/2006  1:33 PM ]
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**1,2,3,4,12**;JAN 09, 2006;Build 101
  1.  ;IHS/OIT/FCJ CHG VEND SECTION TO PRT BTH MAIL/PHY ADD, SPLIT
  1.  ;   RTN AT PAYOR LINE COPIED TO BMCFRPN1 FR PAYOR THRU RR LINE
  1.  ;   PRNT MED HX FR RCIS COMMENTS FILE; ADDED TEST FOR VENDOR ADDRESS
  1.  ;4.0*1 2.15.06 IHS/OIT/FCJ COMBINED CALL IN REF AND PRINT OF NEW
  1.  ;   ADDRESS PARAMETERS
  1.  ;BMC*4.0*2 9.14.06 IHS.OIT.FCJ ADDED SECTION TO PRINT CONSULT LTR
  1.  ;BMC*4.0*3 8.10.07 IHS.OIT.FCJ ADDED NPI AND INS AUTH
  1.  ;BMC*4.0*3 9.15.08 IHS.OIT.FCJ FX FOR UNDEF VAR WHEN QUEUED
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#5450:Modifications to allow printing from EHR GUI
  1.  ;GDIT/HS/BEE 10/19/17 - p12 - Address XINDEX/SAC issues
  1.  ;
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#5450: Renamed old PRINT tag to PRT
  1.  ;                       created separate R&S (PRINT) and GUI (GPRINT) entry pts
  1. PRINT ;EP print referral form - Roll and Scroll Front End
  1.  ;
  1.  NEW PRTGUI,PGL
  1.  S PRTGUI=0
  1.  ;
  1.  ;Page length
  1.  S PGL=IOSL
  1.  ;
  1.  ;Print the Letter
  1.  D PRT
  1.  Q
  1.  ;
  1. GPRINT(BMCREF) ;EP print referral form - GUI
  1.  ;
  1.  NEW PRTGUI,BMCFTYPE,BMCPROUT,PGL
  1.  S PRTGUI=1
  1.  ;
  1.  S PGL=56
  1.  ;
  1.  ;Get the standard referral letter
  1.  S BMCFTYPE=$O(^BMCTFORM("B","STANDARD IHS REFERRAL LETTER","")) Q:BMCFTYPE=""
  1.  ;
  1.  ;Do not print routing slip
  1.  S BMCPROUT=0
  1.  ;
  1.  ;Print the Letter
  1.  D PRT
  1.  Q
  1.  ;
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#5450;Old PRINT tag changed to PRT
  1.  ;PRINT    ;print referral form
  1. PRT ;print referral form
  1.  NEW REFTO,BMCCHSAS,BMCCMT,BMCDA,BMCDFN,BMCFILE,BMCFTYP,BMCNODE,BMCPCON,BMCPG,BMCQUIT,BMCR0,BMCV,BMCVIEN,BMCX,BMCY
  1.  NEW DTOUT,I,X
  1.  ;
  1.  S BMCR0=^BMCREF(BMCREF,0),BMCPG=0,BMCDFN=$P(BMCR0,U,3)
  1.  D @("HEAD"_(2-($E(IOST,1,2)="C-")))
  1.  S BMCQUIT=0
  1.  S X=$P(^BMCTFORM(BMCFTYPE,0),U,2) S N=0,C=1 D W
  1.  S BMCFTYP=$S($E($P(^BMCTFORM(BMCFTYPE,0),U),1,4)="CALL":"CI",1:"S")
  1.  S X=$$VAL^XBDIQ1(90001,BMCREF,.01),C=0,N=0,T=66 D W
  1.  D S
  1. DEMO ;Demographic Data
  1.  Q:BMCQUIT
  1.  S X="Patient Identification, Address, Phone",C=1,T=0,N=1 D W Q:BMCQUIT
  1.  S X="Patient Name:  "_$$VAL^XBDIQ1(90001,BMCREF,.03),C=0,T=0,N=1 D W Q:BMCQUIT
  1.  S X="ID Number:  "_$$HRN^AUPNPAT($P(BMCR0,U,3),DUZ(2),2),N=0,T=50,C=0 D W Q:BMCQUIT
  1.  I $P($G(^BMCPARM(DUZ(2),4100)),U,2)="" S X="SSN:  "_"",C=0,T=9,N=1 D W Q:BMCQUIT
  1.  I $P($G(^BMCPARM(DUZ(2),4100)),U,2)="Y" S X="SSN:  "_$$VAL^XBDIQ1(2,$P(BMCR0,U,3),.09),C=0,T=9,N=1 D W Q:BMCQUIT
  1.  S X="Sex:  "_$$VAL^XBDIQ1(2,$P(BMCR0,U,3),.02),N=0,T=56,C=0 D W Q:BMCQUIT
  1.  S X="Address:  " S:$$VAL^XBDIQ1(9000001,$P(BMCR0,U,3),1602.2)]"" X=X_$$VAL^XBDIQ1(9000001,$P(BMCR0,U,3),1602.2) S C=0,T=5,N=1 D W Q:BMCQUIT
  1.  S X="DOB:  "_$$VAL^XBDIQ1(2,$P(BMCR0,U,3),.03),N=0,T=56,C=0 D W Q:BMCQUIT
  1.  S T=15,C=0,N=1,X=$$VAL^XBDIQ1(9000001,$P(BMCR0,U,3),1603.2)_", "_$$VAL^XBDIQ1(9000001,$P(BMCR0,U,3),1604.2)_"   "_$$VAL^XBDIQ1(9000001,$P(BMCR0,U,3),1605.2) D W Q:BMCQUIT
  1.  S X="Hm Phone: "_$$VAL^XBDIQ1(9000001,$P(BMCR0,U,3),1606.2) S C=0,T=51,N=0 D W Q:BMCQUIT
  1.  ;
  1. REFTO ;
  1.  D L
  1.  ;GDIT/HS/BEE 10/19/17 - p12:Fixed code to address SAC issue
  1.  ;D @$$VALI^XBDIQ1(90001,BMCREF,.04) Q:BMCQUIT
  1.  S REFTO=$$VALI^XBDIQ1(90001,BMCREF,.04)
  1.  D @REFTO Q:BMCQUIT
  1.  S X=$$VAL^XBDIQ1(90001,BMCREF,.02),N=0,C=0,T=64 D W Q:BMCQUIT
  1. DATE ;
  1.  S X=$$VAL^XBDIQ1(90001,BMCREF,.14)_" Services                     "_$S($P(BMCR0,U,14)="I":"Admission Date",1:"Appointment Date")_":  "_$$AVDOS^BMCRLU(BMCREF,"E"),N=1,C=0,T=0 D W Q:BMCQUIT
  1.  ;
  1.  I $P($G(^BMCREF(BMCREF,0)),U,14)="O" S X="# of Outpatient Visits: "_$$VAL^XBDIQ1(90001,BMCREF,1111),C=0,T=0,N=1 D W Q:BMCQUIT
  1.  I $P($G(^BMCREF(BMCREF,0)),U,14)="I" W !
  1.  S X="Expected Ending Date: "_$$VAL^XBDIQ1(90001,BMCREF,1107),C=0,T=40,N=0 D W Q:BMCQUIT
  1.  I $P($G(^BMCREF(BMCREF,0)),U,32)'="" S X="Priority Rating:  "_$$VAL^XBDIQ1(90001,BMCREF,.32),C=0,T=0,N=1 D W Q:BMCQUIT
  1.  ;BMC*4.0*3 8.10.2007 IHS/OIT/FCJ ADDED NXT LINE
  1.  I $P($G(^BMCREF(BMCREF,14)),U,5)'="" S X="Insurance Auth No:  "_$$VAL^XBDIQ1(90001,BMCREF,1405),C=0,T=40,N=0 D W Q:BMCQUIT
  1.  D L
  1. PURPOSE ;
  1.  S X="Purpose/Services Requested: "_$$VAL^XBDIQ1(90001,BMCREF,1201)
  1.  I $L(X)>IOM D  I 1
  1.  .S BMCX=X S X=$E(BMCX,1,IOM),N=1,C=0,T=0 D W Q:BMCQUIT
  1.  .S X=$E(BMCX,(IOM+1),IOM),N=1,C=0,T=22 D W Q:BMCQUIT
  1.  E  S C=0,N=1,T=0 D W Q:BMCQUIT
  1. PERTMED ;
  1.  S BMCCMT=0
  1.  F  S BMCCMT=$O(^BMCCOM("AD",BMCREF,BMCCMT)) Q:BMCCMT'?1N.N  D
  1.  .Q:$P(^BMCCOM(BMCCMT,0),U,5)'="M"
  1.  .S BMCNODE=1,BMCIOM=70,BMCFILE=90001.03,BMCDA=BMCCMT,BMCNODE=1
  1.  .D WP K BMCIOM
  1.  .S Y=0 F  S Y=$O(BMCWP(Y)) Q:Y'=+Y!(BMCQUIT)  D
  1.  ..I $Y>($S($G(PGL)]"":PGL,1:IOSL)-3) D HEAD Q:BMCQUIT   ;GDIT/HS/BEE 10/19/17 - p12 CR#5450:Changed IOSL to PGL
  1.  ..W !?5,BMCWP(Y)
  1. ADDMED ;
  1.  S X="Additional Medical Information Attached:  "_$S($$VAL^XBDIQ1(90001,BMCREF,.34)]"":$$VAL^XBDIQ1(90001,BMCREF,.34),1:" Not Documented by Provider"),C=0,T=0,N=2 D W Q:BMCQUIT
  1. REFFROM ;
  1.  S T=0,X=$TR($J(" ",IOM)," ","_") S N=1,C=0 D W Q:BMCQUIT
  1.  S BMCV=$P(BMCR0,U,5)
  1.  S Y=$P(BMCR0,U,4)
  1.  ;BMC*4.0*3 8.10.2007 IHS/OIT/FCJ SPLIT NEXT LINE TO PRINT NPI IF AVAIL
  1.  I Y="N" D  Q:BMCQUIT  G PAYOR
  1.  .S X="Referring Provider (ELECTRONIC SIGNATURE): "_$$VAL^XBDIQ1(90001,BMCREF,.06),N=1,T=0,C=0 D W Q:BMCQUIT
  1.  .W "XXXXX"
  1.  .S I=$P(BMCR0,U,6) I I,$P($G(^VA(200,I,"NPI")),U) S X="NPI: "_$P(^VA(200,I,"NPI"),U),N=1,T=0,C=0 D W
  1.  ;
  1.  S X="If you have any questions concerning this referral, please contact:",N=1,C=0,T=0 D W Q:BMCQUIT
  1.  S X="     "_$$VAL^XBDIQ1(90001,BMCREF,.05)_$S($$VAL^XBDIQ1(90001.31,DUZ(2),.17)]"":"  (contact: "_$$VAL^XBDIQ1(90001.31,DUZ(2),.17)_")",1:"")_")" S N=1,C=0,T=0 D W Q:BMCQUIT
  1.  ;4.0*1 2.15.06 IHS/OIT/FCJ REWROTE NXT SECTION TO PRNT ADDRESS FR PARM
  1.  I $$VAL^XBDIQ1(90001.31,BMCV,201)'="" D
  1.  .S X=$$VAL^XBDIQ1(90001.31,BMCV,201)
  1.  .I BMCV,X]"" S N=1,C=0,T=5 D W Q:BMCQUIT
  1.  .S X=$$VAL^XBDIQ1(90001.31,BMCV,202)
  1.  .I BMCV,X]"" D
  1.  ..S X=X_",  "_$$VAL^XBDIQ1(90001.31,BMCV,203)
  1.  ..S X=X_"   "_$$VAL^XBDIQ1(90001.31,BMCV,204)
  1.  ..S X=X_"     (phone:  "_$$VAL^XBDIQ1(90001.31,BMCV,.18)_")",N=1,C=0,T=5 D W Q:BMCQUIT
  1.  E  I $$VAL^XBDIQ1(9999999.06,BMCV,.14)'="" D
  1.  .S X=$$VAL^XBDIQ1(9999999.06,BMCV,.14)
  1.  .I BMCV,X]"" S N=1,C=0,T=5 D W Q:BMCQUIT
  1.  .S X=$$VAL^XBDIQ1(9999999.06,BMCV,.15)
  1.  .I BMCV,X]"" D
  1.  ..S X=X_",  "_$$VAL^XBDIQ1(9999999.06,BMCV,.16)
  1.  ..S X=X_"   "_$$VAL^XBDIQ1(9999999.06,BMCV,.17)
  1.  ..S X=X_"     (phone:  "_$$VAL^XBDIQ1(90001.31,BMCV,.18)_")",N=1,C=0,T=5 D W Q:BMCQUIT
  1.  ;4.0*1 2.15.06 IHS/OIT/FCJ END OF CHANGES
  1.  I BMCFTYP'="CI" S X="Referring Provider (ELECTRONIC SIGNATURE):  "_$$VAL^XBDIQ1(90001,BMCREF,.06),N=1,T=6,C=0 D W Q:BMCQUIT
  1.  ;BMC*4.0*3 8.10.2007 IHS/OIT/FCJ ADDED NXT LINE
  1.  I BMCFTYP'="CI" S I=$P(BMCR0,U,6) I I,$P($G(^VA(200,I,"NPI")),U) S X="NPI: "_$P(^VA(200,I,"NPI"),U),N=1,T=6,C=0 D W Q:BMCQUIT
  1.  I BMCFTYP'="CI" S X="Case Manager:  "_$$VAL^XBDIQ1(90001,BMCREF,.19),N=1,T=6,C=0 D W Q:BMCQUIT
  1.  S X="Veteran: "_$$VAL^XBDIQ1(2,$P(BMCR0,U,3),1901),N=1,T=56,C=0 D W
  1.  Q:BMCQUIT
  1. PAYOR ;OTHER PAYOR INFORMATION
  1.  D OTHPAY^BMCFPRN1
  1.  Q:BMCQUIT
  1. TEXT ;
  1.  W ! D S
  1.  K BMCWP
  1.  S BMCCHSAS=$P($G(^BMCREF(BMCREF,11)),U,12)
  1.  I $P(BMCR0,U,4)="C" S BMCNODE=$S(BMCCHSAS="A":1,BMCCHSAS="D":2,BMCCHSAS="P":3,1:3) S BMCFILE=90001.33,BMCDA=BMCFTYPE D WPTXT
  1.  I $P(BMCR0,U,4)="O" S BMCNODE=2,BMCFILE=90001.33,BMCDA=BMCFTYPE D WPTXT
  1.  I $P(BMCR0,U,4)="I"!($P(BMCR0,U,4)="N") W ! S BMCWP(1)=""
  1.  ;
  1.  S BMCY=0 F  S BMCY=$O(BMCWP(BMCY)) Q:BMCY'=+BMCY!(BMCQUIT)  D
  1.  .I $Y>($S($G(PGL)]"":PGL,1:IOSL)-3) D HEAD Q:BMCQUIT  ;GDIT/HS/BEE 10/19/17 - p12 CR#5450:Changed IOSL to PGL
  1.  .W !,BMCWP(BMCY)
  1.  ;
  1. LINE ;CHS Supervisor Signature (if Type=CHS)
  1.  G:$P(BMCR0,U,4)'="C" ROUT
  1.  W !!!!!
  1.  G:BMCFTYP="CI" ROUT
  1.  S X="____________________",C=0,T=50,N=1 D W Q:BMCQUIT
  1.  W !
  1.  S X="Contract Health Service Office",C=0,T=50,N=1 D W Q:BMCQUIT
  1. ROUT ;Print Routing slip
  1.  I BMCPROUT=1 W # D PRINT^BMCFDRS
  1.  ;BMC*4.0*2 9.14.06 IHS.OIT.FCJ ADDED NXT SECTION TO PRINT CONSULT LTR
  1. CONSULT ;PRINT CONSULT LETTER
  1.  I $G(BMCPCON)=1 W # D PRINT^BMCFDRP  ;BMC*4.0*4 IHS.OIT.FCJ CHANGED TO $G
  1.  Q
  1. W ;Entry Point
  1.  Q:X=""
  1.  NEW %
  1.  S %=$L(X)
  1.  I $Y>($S($G(PGL)]"":PGL,1:IOSL)-4) D HEAD Q:BMCQUIT  ;GDIT/HS/BEE 10/19/17 - p12 CR#5450:Changed IOSL to PGL
  1.  I N F I=1:1:N W !
  1.  I $G(C) W ?(IOM-$L(X)/2),X Q
  1.  S %=$S($G(T):T,1:0) W ?%,X
  1.  Q
  1. C ;
  1.  S BMCV=$P(BMCR0,U,7)
  1.  Q:'BMCV
  1.  S X="Referred to:       "_$$VAL^XBDIQ1(90001,BMCREF,.07)_$S($$VAL^XBDIQ1(9999999.11,BMCV,1109)]"":"  ("_$$VAL^XBDIQ1(9999999.11,BMCV,1109)_")",1:""),N=1,C=0,T=0 D W Q:BMCQUIT
  1.  I $P(BMCR0,U,9) S X="("_$$VAL^XBDIQ1(90001,BMCREF,.09)_")",N=1,C=0,T=19 D W Q:BMCQUIT
  1.  S X="Mailing: "_$$VAL^XBDIQ1(9999999.11,BMCV,1301),N=1,C=0,T=0 D W Q:BMCQUIT
  1.  S X="Physical: "_$$VAL^XBDIQ1(9999999.11,BMCV,1306),N=0,C=0,T=40 D W Q:BMCQUIT
  1.  ;IHS/ITSC/FCJ MOD TO NOT REQUIRE ADDRESS FOR VENDOR
  1.  I $G(^AUTTVNDR(BMCV,13))'="" D  Q:BMCQUIT
  1.  .S BMCVIEN=$P(^AUTTVNDR(BMCV,13),U,3)
  1.  .S X=$$VAL^XBDIQ1(9999999.11,BMCV,1302)_", "
  1.  .I BMCVIEN'="" S X=X_$$VAL^XBDIQ1(5,BMCVIEN,1)_" "_$$VAL^XBDIQ1(9999999.11,BMCV,1304)
  1.  .S N=1,C=0,T=9 D W
  1.  .I $$VAL^XBDIQ1(9999999.11,BMCV,1306)'="" D  Q:BMCQUIT
  1.  ..S BMCVIEN=$P(^AUTTVNDR(BMCV,13),U,8)
  1.  ..S X=$$VAL^XBDIQ1(9999999.11,BMCV,1307)_", "
  1.  ..I BMCVIEN'="" S X=X_$$VAL^XBDIQ1(5,BMCVIEN,1)
  1.  ..S X=X_" "_$$VAL^XBDIQ1(9999999.11,BMCV,1309)
  1.  ..S:X'?1A.E X=""
  1.  ..S N=0,C=0,T=50 D W
  1.  W !
  1.  Q
  1. I ;
  1.  S BMCV=$P(BMCR0,U,8)
  1.  Q:'BMCV
  1.  S X="Referred to:       "_$$VAL^XBDIQ1(90001,BMCREF,.08)_$S($$VAL^XBDIQ1(9999999.06,BMCV,.13)]"":"  ("_$$VAL^XBDIQ1(9999999.06,BMCV,.13)_")",1:"") S N=1,C=0,T=0 D W Q:BMCQUIT
  1.  I $P(BMCR0,U,9) S X="("_$$VAL^XBDIQ1(90001,BMCREF,.09)_")" S N=1,C=0,T=19 D W Q:BMCQUIT
  1.  I $$VAL^XBDIQ1(9999999.06,BMCV,.14)]"" S X=$$VAL^XBDIQ1(9999999.06,BMCV,.14) S N=1,C=0,T=19 D W Q:BMCQUIT
  1.  I $$VAL^XBDIQ1(9999999.06,BMCV,.15)]"" S X=$$VAL^XBDIQ1(9999999.06,BMCV,.15)_",  "_$$VAL^XBDIQ1(9999999.06,BMCV,.16)_"   "_$$VAL^XBDIQ1(9999999.06,BMCV,.17),N=1,C=0,T=19 D W Q:BMCQUIT
  1.  Q
  1. N ;
  1.  S X="IN HOUSE REFERRAL",N=1,C=0,T=0 D W Q:BMCQUIT
  1.  S X="Referred to:  "_$$VAL^XBDIQ1(90001,BMCREF,.23)_" clinic",N=1,C=0,T=0 D W Q:BMCQUIT
  1.  Q
  1. O ;
  1.  S BMCV=$P(BMCR0,U,7)
  1.  I BMCV D  I 1
  1.  .S X="Referred to:       "_$$VAL^XBDIQ1(90001,BMCREF,.07)_$S($$VAL^XBDIQ1(9999999.11,BMCV,1109)]"":"  ("_$$VAL^XBDIQ1(9999999.11,BMCV,1109)_")",1:"") S N=1,C=0,T=0 D W Q:BMCQUIT
  1.  .I $P(BMCR0,U,9) S X="("_$$VAL^XBDIQ1(90001,BMCREF,.09)_")" S N=1,C=0,T=19 D W Q:BMCQUIT
  1.  .I $$VAL^XBDIQ1(9999999.11,BMCV,1301)]"" S X=$$VAL^XBDIQ1(9999999.11,BMCV,1301)_$S($$VAL^XBDIQ1(9999999.11,BMCV,1310)]"":",  "_$$VAL^XBDIQ1(9999999.11,BMCV,1310),1:"") S N=1,C=0,T=19 D W Q:BMCQUIT
  1.  .I $$VAL^XBDIQ1(9999999.11,BMCV,1302)]"" S X=$$VAL^XBDIQ1(9999999.11,BMCV,1302)_",  "_$$VAL^XBDIQ1(9999999.11,BMCV,1303)_"   "_$$VAL^XBDIQ1(9999999.11,BMCV,1304),N=1,C=0,T=19 D W Q:BMCQUIT
  1.  E  S X="Referred to:  "_$$VAL^XBDIQ1(90001,BMCREF,.09),N=1,C=0,T=0 D W Q:BMCQUIT
  1.  Q
  1. L ;
  1.  S T=0,X=$TR($J(" ",IOM)," ","_"),N=1,C=0 D W Q:BMCQUIT
  1.  Q
  1. D ;
  1.  S T=0,X=$TR($J(" ",IOM)," ","-"),N=1,C=0 D W Q:BMCQUIT
  1.  Q
  1. S ;
  1.  S T=0,X=$TR($J(" ",IOM)," ","*"),N=1,C=0 D W Q:BMCQUIT
  1.  Q
  1. WPTXT ;
  1.  ; get site-specific text (if any)
  1.  I $P(BMCR0,U,4)="C" D
  1.  .I BMCCHSAS="A",$D(^BMCPARM(DUZ(2),31)) S BMCFILE=90001.31,BMCDA=DUZ(2),BMCNODE=31
  1.  .I BMCCHSAS="D",$D(^BMCPARM(DUZ(2),32)) S BMCFILE=90001.31,BMCDA=DUZ(2),BMCNODE=32
  1.  .I BMCCHSAS="P"!(BMCCHSAS=""),$D(^BMCPARM(DUZ(2),33)) S BMCFILE=90001.31,BMCDA=DUZ(2),BMCNODE=33
  1.  I $P(BMCR0,U,4)="O",$D(^BMCPARM(DUZ(2),33)) S BMCFILE=90001.31,BMCDA=DUZ(2),BMCNODE=34
  1.  ; fall through to WP to get the text
  1. WP ;
  1.  D WP^BMCFDR
  1.  Q
  1.  ;
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#5450:Added references to PRTGUI to control GUI display formatting
  1.  ;HEAD     ;
  1.  ; NEW N,T,C,X,Y
  1.  ; I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BMCQUIT=1 Q
  1.  ;HEAD1    ;
  1.  ; W:$D(IOF) @IOF
  1.  ;HEAD2    ;
  1.  ; I 'BMCPG S BMCPG=BMCPG+1 Q
  1.  ; S BMCPG=BMCPG+1 W:$D(IOF) @IOF W !,?(IOM-20),"Page ",BMCPG
  1.  NEW N,T,C,X,Y
  1.  I '$G(PRTGUI),$E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BMCQUIT=1 Q
  1. HEAD1 ;
  1.  I '$G(PRTGUI) W:$D(IOF) @IOF
  1. HEAD2 ;
  1.  I 'BMCPG S BMCPG=BMCPG+1 Q
  1.  S BMCPG=BMCPG+1 I '$G(PRTGUI) W:$D(IOF) @IOF W !,?(IOM-20),"Page ",BMCPG
  1.  ;End of CR#5450 changes
  1.  Q