BTIULO18 ; IHS/MSC/MGH - EYE RX OBJECT ;06-Jan-2016 12:11;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1016**;NOV 04, 2004;Build 10
EYERX(DFN,EYE,TARGET) ;Print eye-glass prescription
N INVDT,BGOIEN,CNT
S (INVDT,BGOIEN)=""
S EYE=$G(EYE)
K @TARGET
S CNT=0
S INVDT=$O(^AUPNVEYE("AA",DFN,""))
I INVDT="" S @TARGET@(1,0)="No eye exam on file"
E D
.S BGOIEN=9999999
.S BGOIEN=$O(^AUPNVEYE("AA",DFN,INVDT,BGOIEN),-1) D
..I BGOIEN="" S @TARGET@(1,0)="No eye exam on file"
..D PRINT(BGOIEN,EYE)
I CNT=0 S @TARGET@(1,0)="No eye exam on file"
Q "~@"_$NA(@TARGET)
PRINT(BGOIEN,EYE) ;print out the RX
N X,J,BGODFN,ONE,EDATA,READ,PAT,FNUM,DASH,UNDER,SPACE,PROV,PROVNAME,ADDR,ADDR2,FAC
N VDATE,VIEN,EDATE,COMMENT,LSPHERE,RSPHERE,LAXIS,RAXIS,LCYL,RCYL,LPD,RPD,LREAD,RREAD
N LPRISMH,PDNEAR,PDFAR,LRPISMH,LPRISMHN,LPRISMHV,LPRISMV,LPRISMVN,LPRISMVV,RPRISMH,RPRISMHN,RPRISMV,RPRISMHV,RPRISMVN,RPRISMVV
N ZIP,DASH2,SPACE2,STATE,CITY,LHX,LVT,RHX,RVT,PATNAME,INST,X1,FTXT,NTXT,TYPE
N DIWF,DIWL,DIWR
S FNUM=$$FNUM
S ONE=$G(^AUPNVEYE(BGOIEN,0))
S EDATA=$G(^AUPNVEYE(BGOIEN,19))
;Get pt data
S PAT=$P(ONE,U,2)
S PATNAME=$$FNAME^BTIUPCC2(PAT)_" "_$$LNAME^BTIUPCC2(PAT)
S PAT=$$GET1^DIQ(2,$P(ONE,U,2),.01)
S VDATE=$$GET1^DIQ(9000010,$P(ONE,U,3),.01)
S PROV=$P($G(^AUPNVEYE(BGOIEN,12)),U,4)
I PROV'="" S PROVNAME=$P($G(^VA(200,PROV,20)),U,2)
S X=$$SITE^VASITE()
S INST=$P(X,U,1)
S FAC=$P(X,U,2)
S ADDR=$$GET1^DIQ(4,INST,1.01)
S ADDR2=$$GET1^DIQ(4,INST,1.02)
S STATE=$$GET1^DIQ(4,INST,.02)
S CITY=$$GET1^DIQ(4,INST,1.03)
S ZIP=$$GET1^DIQ(4,INST,1.04)
I EYE="R" D RIGHT(EDATA)
I EYE="L" D LEFT(EDATA)
I EYE="P" D PUPIL(EDATA)
Q
;Get right eye data
RIGHT(EDATA) ;EP
S RSPHERE=$$EXTERNAL^DILFD(FNUM,1902,,$P(EDATA,U,2))
I RSPHERE="" S RSPHERE=" "
S RCYL=$$EXTERNAL^DILFD(FNUM,1903,,$P(EDATA,U,3))
I RCYL="" S RCYL=" "
S RAXIS=$$EXTERNAL^DILFD(FNUM,1904,,$P(EDATA,U,4))
I RAXIS="" S RAXIS=" "
S RREAD=$$EXTERNAL^DILFD(FNUM,1908,,$P(EDATA,U,8))
S RPRISMH=$$EXTERNAL^DILFD(FNUM,1915,,$P(EDATA,U,15))
S RPRISMHN=+RPRISMH
I RPRISMHN=0 S RPRISMHN=""
S RPRISMHV=$S(RPRISMH["BI":"BI",RPRISMH["BO":"BO",RPRISMH["BU":"BU",RPRISMH["BD":"BD",1:"")
S RPRISMV=$$EXTERNAL^DILFD(FNUM,1917,,$P(EDATA,U,17))
S RPRISMVN=+RPRISMH
I RPRISMVN=0 S RPRISMVN=""
S RPRISMVV=$S(RPRISMV["BI":"BI",RPRISMV["BO":"BO",RPRISMV["BU":"BU",RPRISMV["BD":"BD",1:"")
S RPD=$$EXTERNAL^DILFD(FNUM,1920,,$P(EDATA,U,20))
S READ=$$EXTERNAL^DILFD(FNUM,1901,,$P(EDATA,U,1))
S COMMENT=$G(^AUPNVEYE(BGOIEN,11))
S $P(DASH,"-",65)="-"
S DASH2=$$STRING
S $P(SPACE," ",65)=" "
S $p(SPACE2," ",63)=" "
S $P(UNDER,"_",12)="_"
D PRIGHT
Q
;Get left eye data
LEFT(EDATA) ;EP
S LSPHERE=$$EXTERNAL^DILFD(FNUM,1902,,$P(EDATA,U,5))
I LSPHERE="" S LSPHERE=" "
S LCYL=$$EXTERNAL^DILFD(FNUM,1903,,$P(EDATA,U,6))
I LCYL="" S LCYL=" "
S LAXIS=$$EXTERNAL^DILFD(FNUM,1904,,$P(EDATA,U,7))
I LAXIS="" S LAXIS=" "
S LREAD=$$EXTERNAL^DILFD(FNUM,1909,,$P(EDATA,U,9))
S LPRISMH=$$EXTERNAL^DILFD(FNUM,1915,,$P(EDATA,U,16))
S LPRISMHN=+LPRISMH
I LPRISMHN=0 S LPRISMHN=""
S LPRISMHV=$S(LPRISMH["BI":"BI",LPRISMH["BO":"BO",LPRISMH["BU":"BU",LPRISMH["BD":"BD",1:"")
S LPRISMV=$$EXTERNAL^DILFD(FNUM,1917,,$P(EDATA,U,18))
S LPRISMVN=+LPRISMV
I LPRISMVN=0 S LPRISMVN=""
S LPRISMVV=$S(LPRISMV["BI":"BI",LPRISMV["BO":"BO",LPRISMV["BU":"BU",LPRISMV["BD":"BD",1:"")
S LPD=$$EXTERNAL^DILFD(FNUM,1919,,$P(EDATA,U,19))
S READ=$$EXTERNAL^DILFD(FNUM,1901,,$P(EDATA,U,1))
S COMMENT=$G(^AUPNVEYE(BGOIEN,11))
S $P(DASH,"-",65)="-"
S DASH2=$$STRING
S $P(SPACE," ",65)=" "
S $p(SPACE2," ",63)=" "
S $P(UNDER,"_",12)="_"
D PLEFT
Q
;Pupil distance
PUPIL(EDATA) ;EP for pupil distance
S RPD=$$EXTERNAL^DILFD(FNUM,1920,,$P(EDATA,U,20))
S LPD=$$EXTERNAL^DILFD(FNUM,1919,,$P(EDATA,U,19))
S PDNEAR=$$EXTERNAL^DILFD(FNUM,1913,,$P(EDATA,U,13))
I PDNEAR="" S PDNEAR=" "
S PDFAR=$$EXTERNAL^DILFD(FNUM,1914,,$P(EDATA,U,14))
I PDFAR="" S PDFAR=" "
S READ=$$EXTERNAL^DILFD(FNUM,1901,,$P(EDATA,U,1))
S COMMENT=$G(^AUPNVEYE(BGOIEN,11))
S $P(DASH,"-",65)="-"
S DASH2=$$STRING
S $P(SPACE," ",65)=" "
S $p(SPACE2," ",63)=" "
S $P(UNDER,"_",12)="_"
D PPUPIL
Q
PRIGHT ;Write out right eye prescription
D COMMON
S RHX=RPRISMHN_RPRISMHV
S RVT=RPRISMVN_RPRISMVV
S CNT=CNT+1
S @TARGET@(CNT,0)="Right Eye Exam"
S CNT=CNT+1
S @TARGET@(CNT,0)=DASH
S CNT=CNT+1
S @TARGET@(CNT,0)=" SPHERE CYL AXIS NEAR PRISM PRISM"
S CNT=CNT+1
S @TARGET@(CNT,0)=" ADD HZ VT"
S CNT=CNT+1
S @TARGET@(CNT,0)=DASH
S CNT=CNT+1
S @TARGET@(CNT,0)="OD "_RSPHERE_" "_RCYL_" "_RAXIS_" "_RREAD_" "_RHX_" "_RVT
W $L(@TARGET@(CNT,0))
S CNT=CNT+1
S @TARGET@(CNT,0)=" "
D FINISH
Q
PLEFT ; Wright out left eye prescription
D COMMON
S LHX=LPRISMHN_LPRISMHV
S LVT=LPRISMVN_LPRISMVV
S CNT=CNT+1
S @TARGET@(CNT,0)="Left Eye Exam"
S CNT=CNT+1
S @TARGET@(CNT,0)=DASH
S CNT=CNT+1
S @TARGET@(CNT,0)=" SPHERE CYL AXIS NEAR PRISM PRISM"
S CNT=CNT+1
S @TARGET@(CNT,0)=" ADD HZ VT"
S CNT=CNT+1
S @TARGET@(CNT,0)=DASH
S CNT=CNT+1
S @TARGET@(CNT,0)="OS "_LSPHERE_" "_LCYL_" "_LAXIS_" "_LREAD_" "_LHX_" "_LVT
W $L(@TARGET@(CNT,0))
S CNT=CNT+1
S @TARGET@(CNT,0)=" "
D FINISH
Q
PPUPIL ;Write out pupil distance
D COMMON
S CNT=CNT+1
S @TARGET@(CNT,0)="Pupil Distance"
S CNT=CNT+1
S @TARGET@(CNT,0)=DASH
S NTXT="" I +RPD S NTXT="R PUPIL"
S FTXT="" I +LPD S FTXT="L PUPIL"
S CNT=CNT+1
S @TARGET@(CNT,0)=" NEAR DISTANCE "_NTXT_" "_FTXT
S CNT=CNT+1
S @TARGET@(CNT,0)=" "_PDNEAR_" "_PDFAR_" "_RPD_" "_LPD
S CNT=CNT+1
S @TARGET@(CNT,0)=" "
D FINISH
Q
COMMON ;Write out the data common to all 3 prescriptions
S CNT=CNT+1
S @TARGET@(CNT,0)=""
S CNT=CNT+1
S @TARGET@(CNT,0)=""
S CNT=CNT+1
S @TARGET@(CNT,0)=DASH
S CNT=CNT+1
S @TARGET@(CNT,0)=SPACE
S CNT=CNT+1
S @TARGET@(CNT,0)=" "_FAC
S @TARGET@(CNT,0)=" "_ADDR
S CNT=CNT+1
S @TARGET@(CNT,0)=" "_CITY_" "_STATE_" "_ZIP
I ADDR2'="" D
.S CNT=CNT+1
.S @TARGET@(CNT,0)=" "_ADDR2
S CNT=CNT+1
S @TARGET@(CNT,0)=SPACE
S CNT=CNT+1
S @TARGET@(CNT,0)="Patient: "_PATNAME_" Date: "_VDATE
S CNT=CNT+1
S @TARGET@(CNT,0)=" Expiration: "_UNDER
S CNT=CNT+1
S @TARGET@(CNT,0)=SPACE
Q
FINISH ;Bottom of RX
S CNT=CNT+1
S @TARGET@(CNT,0)="Instructions"
S TYPE=$P(COMMENT,"~",1),COMMENT=$P(COMMENT,"~",2)
S CNT=CNT+1
S @TARGET@(CNT,0)=" "_TYPE
S CNT=CNT+1
S @TARGET@(CNT,0)=""
K ^UTILITY($J,"W")
S X=COMMENT,DIWL=0,DIWR=60,DIWF="" D ^DIWP
S J=$G(^UTILITY($J,"W",0))
F I=1:1:J S CNT=CNT+1 S @TARGET@(CNT,0)=" "_$G(^UTILITY($J,"W",0,I,0))
K ^UTILITY($J,"W")
S CNT=CNT+1
S @TARGET@(CNT,0)=""
S CNT=CNT+1
S @TARGET@(CNT,0)="Provider: "_PROVNAME
S CNT=CNT+1
S @TARGET@(CNT,0)=DASH
Q
EYE(DFN,TARGET) ;print RX
FNUM() Q 9000010.04
STRING() N STR,VAL,I
S STR=""
F I=1:1:62 S STR=STR_"-"
S VAL=STR
Q VAL
BTIULO18 ; IHS/MSC/MGH - EYE RX OBJECT ;06-Jan-2016 12:11;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1016**;NOV 04, 2004;Build 10
EYERX(DFN,EYE,TARGET) ;Print eye-glass prescription
+1 NEW INVDT,BGOIEN,CNT
+2 SET (INVDT,BGOIEN)=""
+3 SET EYE=$GET(EYE)
+4 KILL @TARGET
+5 SET CNT=0
+6 SET INVDT=$ORDER(^AUPNVEYE("AA",DFN,""))
+7 IF INVDT=""
SET @TARGET@(1,0)="No eye exam on file"
+8 IF '$TEST
Begin DoDot:1
+9 SET BGOIEN=9999999
+10 SET BGOIEN=$ORDER(^AUPNVEYE("AA",DFN,INVDT,BGOIEN),-1)
Begin DoDot:2
+11 IF BGOIEN=""
SET @TARGET@(1,0)="No eye exam on file"
+12 DO PRINT(BGOIEN,EYE)
End DoDot:2
End DoDot:1
+13 IF CNT=0
SET @TARGET@(1,0)="No eye exam on file"
+14 QUIT "~@"_$NAME(@TARGET)
PRINT(BGOIEN,EYE) ;print out the RX
+1 NEW X,J,BGODFN,ONE,EDATA,READ,PAT,FNUM,DASH,UNDER,SPACE,PROV,PROVNAME,ADDR,ADDR2,FAC
+2 NEW VDATE,VIEN,EDATE,COMMENT,LSPHERE,RSPHERE,LAXIS,RAXIS,LCYL,RCYL,LPD,RPD,LREAD,RREAD
+3 NEW LPRISMH,PDNEAR,PDFAR,LRPISMH,LPRISMHN,LPRISMHV,LPRISMV,LPRISMVN,LPRISMVV,RPRISMH,RPRISMHN,RPRISMV,RPRISMHV,RPRISMVN,RPRISMVV
+4 NEW ZIP,DASH2,SPACE2,STATE,CITY,LHX,LVT,RHX,RVT,PATNAME,INST,X1,FTXT,NTXT,TYPE
+5 NEW DIWF,DIWL,DIWR
+6 SET FNUM=$$FNUM
+7 SET ONE=$GET(^AUPNVEYE(BGOIEN,0))
+8 SET EDATA=$GET(^AUPNVEYE(BGOIEN,19))
+9 ;Get pt data
+10 SET PAT=$PIECE(ONE,U,2)
+11 SET PATNAME=$$FNAME^BTIUPCC2(PAT)_" "_$$LNAME^BTIUPCC2(PAT)
+12 SET PAT=$$GET1^DIQ(2,$PIECE(ONE,U,2),.01)
+13 SET VDATE=$$GET1^DIQ(9000010,$PIECE(ONE,U,3),.01)
+14 SET PROV=$PIECE($GET(^AUPNVEYE(BGOIEN,12)),U,4)
+15 IF PROV'=""
SET PROVNAME=$PIECE($GET(^VA(200,PROV,20)),U,2)
+16 SET X=$$SITE^VASITE()
+17 SET INST=$PIECE(X,U,1)
+18 SET FAC=$PIECE(X,U,2)
+19 SET ADDR=$$GET1^DIQ(4,INST,1.01)
+20 SET ADDR2=$$GET1^DIQ(4,INST,1.02)
+21 SET STATE=$$GET1^DIQ(4,INST,.02)
+22 SET CITY=$$GET1^DIQ(4,INST,1.03)
+23 SET ZIP=$$GET1^DIQ(4,INST,1.04)
+24 IF EYE="R"
DO RIGHT(EDATA)
+25 IF EYE="L"
DO LEFT(EDATA)
+26 IF EYE="P"
DO PUPIL(EDATA)
+27 QUIT
+28 ;Get right eye data
RIGHT(EDATA) ;EP
+1 SET RSPHERE=$$EXTERNAL^DILFD(FNUM,1902,,$PIECE(EDATA,U,2))
+2 IF RSPHERE=""
SET RSPHERE=" "
+3 SET RCYL=$$EXTERNAL^DILFD(FNUM,1903,,$PIECE(EDATA,U,3))
+4 IF RCYL=""
SET RCYL=" "
+5 SET RAXIS=$$EXTERNAL^DILFD(FNUM,1904,,$PIECE(EDATA,U,4))
+6 IF RAXIS=""
SET RAXIS=" "
+7 SET RREAD=$$EXTERNAL^DILFD(FNUM,1908,,$PIECE(EDATA,U,8))
+8 SET RPRISMH=$$EXTERNAL^DILFD(FNUM,1915,,$PIECE(EDATA,U,15))
+9 SET RPRISMHN=+RPRISMH
+10 IF RPRISMHN=0
SET RPRISMHN=""
+11 SET RPRISMHV=$SELECT(RPRISMH["BI":"BI",RPRISMH["BO":"BO",RPRISMH["BU":"BU",RPRISMH["BD":"BD",1:"")
+12 SET RPRISMV=$$EXTERNAL^DILFD(FNUM,1917,,$PIECE(EDATA,U,17))
+13 SET RPRISMVN=+RPRISMH
+14 IF RPRISMVN=0
SET RPRISMVN=""
+15 SET RPRISMVV=$SELECT(RPRISMV["BI":"BI",RPRISMV["BO":"BO",RPRISMV["BU":"BU",RPRISMV["BD":"BD",1:"")
+16 SET RPD=$$EXTERNAL^DILFD(FNUM,1920,,$PIECE(EDATA,U,20))
+17 SET READ=$$EXTERNAL^DILFD(FNUM,1901,,$PIECE(EDATA,U,1))
+18 SET COMMENT=$GET(^AUPNVEYE(BGOIEN,11))
+19 SET $PIECE(DASH,"-",65)="-"
+20 SET DASH2=$$STRING
+21 SET $PIECE(SPACE," ",65)=" "
+22
*** ERROR ***
SET $p(SPACE2," ",63)=" "
+23 SET $PIECE(UNDER,"_",12)="_"
+24 DO PRIGHT
+25 QUIT
+26 ;Get left eye data
LEFT(EDATA) ;EP
+1 SET LSPHERE=$$EXTERNAL^DILFD(FNUM,1902,,$PIECE(EDATA,U,5))
+2 IF LSPHERE=""
SET LSPHERE=" "
+3 SET LCYL=$$EXTERNAL^DILFD(FNUM,1903,,$PIECE(EDATA,U,6))
+4 IF LCYL=""
SET LCYL=" "
+5 SET LAXIS=$$EXTERNAL^DILFD(FNUM,1904,,$PIECE(EDATA,U,7))
+6 IF LAXIS=""
SET LAXIS=" "
+7 SET LREAD=$$EXTERNAL^DILFD(FNUM,1909,,$PIECE(EDATA,U,9))
+8 SET LPRISMH=$$EXTERNAL^DILFD(FNUM,1915,,$PIECE(EDATA,U,16))
+9 SET LPRISMHN=+LPRISMH
+10 IF LPRISMHN=0
SET LPRISMHN=""
+11 SET LPRISMHV=$SELECT(LPRISMH["BI":"BI",LPRISMH["BO":"BO",LPRISMH["BU":"BU",LPRISMH["BD":"BD",1:"")
+12 SET LPRISMV=$$EXTERNAL^DILFD(FNUM,1917,,$PIECE(EDATA,U,18))
+13 SET LPRISMVN=+LPRISMV
+14 IF LPRISMVN=0
SET LPRISMVN=""
+15 SET LPRISMVV=$SELECT(LPRISMV["BI":"BI",LPRISMV["BO":"BO",LPRISMV["BU":"BU",LPRISMV["BD":"BD",1:"")
+16 SET LPD=$$EXTERNAL^DILFD(FNUM,1919,,$PIECE(EDATA,U,19))
+17 SET READ=$$EXTERNAL^DILFD(FNUM,1901,,$PIECE(EDATA,U,1))
+18 SET COMMENT=$GET(^AUPNVEYE(BGOIEN,11))
+19 SET $PIECE(DASH,"-",65)="-"
+20 SET DASH2=$$STRING
+21 SET $PIECE(SPACE," ",65)=" "
+22
*** ERROR ***
SET $p(SPACE2," ",63)=" "
+23 SET $PIECE(UNDER,"_",12)="_"
+24 DO PLEFT
+25 QUIT
+26 ;Pupil distance
PUPIL(EDATA) ;EP for pupil distance
+1 SET RPD=$$EXTERNAL^DILFD(FNUM,1920,,$PIECE(EDATA,U,20))
+2 SET LPD=$$EXTERNAL^DILFD(FNUM,1919,,$PIECE(EDATA,U,19))
+3 SET PDNEAR=$$EXTERNAL^DILFD(FNUM,1913,,$PIECE(EDATA,U,13))
+4 IF PDNEAR=""
SET PDNEAR=" "
+5 SET PDFAR=$$EXTERNAL^DILFD(FNUM,1914,,$PIECE(EDATA,U,14))
+6 IF PDFAR=""
SET PDFAR=" "
+7 SET READ=$$EXTERNAL^DILFD(FNUM,1901,,$PIECE(EDATA,U,1))
+8 SET COMMENT=$GET(^AUPNVEYE(BGOIEN,11))
+9 SET $PIECE(DASH,"-",65)="-"
+10 SET DASH2=$$STRING
+11 SET $PIECE(SPACE," ",65)=" "
+12
*** ERROR ***
SET $p(SPACE2," ",63)=" "
+13 SET $PIECE(UNDER,"_",12)="_"
+14 DO PPUPIL
+15 QUIT
PRIGHT ;Write out right eye prescription
+1 DO COMMON
+2 SET RHX=RPRISMHN_RPRISMHV
+3 SET RVT=RPRISMVN_RPRISMVV
+4 SET CNT=CNT+1
+5 SET @TARGET@(CNT,0)="Right Eye Exam"
+6 SET CNT=CNT+1
+7 SET @TARGET@(CNT,0)=DASH
+8 SET CNT=CNT+1
+9 SET @TARGET@(CNT,0)=" SPHERE CYL AXIS NEAR PRISM PRISM"
+10 SET CNT=CNT+1
+11 SET @TARGET@(CNT,0)=" ADD HZ VT"
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=DASH
+14 SET CNT=CNT+1
+15 SET @TARGET@(CNT,0)="OD "_RSPHERE_" "_RCYL_" "_RAXIS_" "_RREAD_" "_RHX_" "_RVT
+16 WRITE $LENGTH(@TARGET@(CNT,0))
+17 SET CNT=CNT+1
+18 SET @TARGET@(CNT,0)=" "
+19 DO FINISH
+20 QUIT
PLEFT ; Wright out left eye prescription
+1 DO COMMON
+2 SET LHX=LPRISMHN_LPRISMHV
+3 SET LVT=LPRISMVN_LPRISMVV
+4 SET CNT=CNT+1
+5 SET @TARGET@(CNT,0)="Left Eye Exam"
+6 SET CNT=CNT+1
+7 SET @TARGET@(CNT,0)=DASH
+8 SET CNT=CNT+1
+9 SET @TARGET@(CNT,0)=" SPHERE CYL AXIS NEAR PRISM PRISM"
+10 SET CNT=CNT+1
+11 SET @TARGET@(CNT,0)=" ADD HZ VT"
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=DASH
+14 SET CNT=CNT+1
+15 SET @TARGET@(CNT,0)="OS "_LSPHERE_" "_LCYL_" "_LAXIS_" "_LREAD_" "_LHX_" "_LVT
+16 WRITE $LENGTH(@TARGET@(CNT,0))
+17 SET CNT=CNT+1
+18 SET @TARGET@(CNT,0)=" "
+19 DO FINISH
+20 QUIT
PPUPIL ;Write out pupil distance
+1 DO COMMON
+2 SET CNT=CNT+1
+3 SET @TARGET@(CNT,0)="Pupil Distance"
+4 SET CNT=CNT+1
+5 SET @TARGET@(CNT,0)=DASH
+6 SET NTXT=""
IF +RPD
SET NTXT="R PUPIL"
+7 SET FTXT=""
IF +LPD
SET FTXT="L PUPIL"
+8 SET CNT=CNT+1
+9 SET @TARGET@(CNT,0)=" NEAR DISTANCE "_NTXT_" "_FTXT
+10 SET CNT=CNT+1
+11 SET @TARGET@(CNT,0)=" "_PDNEAR_" "_PDFAR_" "_RPD_" "_LPD
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=" "
+14 DO FINISH
+15 QUIT
COMMON ;Write out the data common to all 3 prescriptions
+1 SET CNT=CNT+1
+2 SET @TARGET@(CNT,0)=""
+3 SET CNT=CNT+1
+4 SET @TARGET@(CNT,0)=""
+5 SET CNT=CNT+1
+6 SET @TARGET@(CNT,0)=DASH
+7 SET CNT=CNT+1
+8 SET @TARGET@(CNT,0)=SPACE
+9 SET CNT=CNT+1
+10 SET @TARGET@(CNT,0)=" "_FAC
+11 SET @TARGET@(CNT,0)=" "_ADDR
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=" "_CITY_" "_STATE_" "_ZIP
+14 IF ADDR2'=""
Begin DoDot:1
+15 SET CNT=CNT+1
+16 SET @TARGET@(CNT,0)=" "_ADDR2
End DoDot:1
+17 SET CNT=CNT+1
+18 SET @TARGET@(CNT,0)=SPACE
+19 SET CNT=CNT+1
+20 SET @TARGET@(CNT,0)="Patient: "_PATNAME_" Date: "_VDATE
+21 SET CNT=CNT+1
+22 SET @TARGET@(CNT,0)=" Expiration: "_UNDER
+23 SET CNT=CNT+1
+24 SET @TARGET@(CNT,0)=SPACE
+25 QUIT
FINISH ;Bottom of RX
+1 SET CNT=CNT+1
+2 SET @TARGET@(CNT,0)="Instructions"
+3 SET TYPE=$PIECE(COMMENT,"~",1)
SET COMMENT=$PIECE(COMMENT,"~",2)
+4 SET CNT=CNT+1
+5 SET @TARGET@(CNT,0)=" "_TYPE
+6 SET CNT=CNT+1
+7 SET @TARGET@(CNT,0)=""
+8 KILL ^UTILITY($JOB,"W")
+9 SET X=COMMENT
SET DIWL=0
SET DIWR=60
SET DIWF=""
DO ^DIWP
+10 SET J=$GET(^UTILITY($JOB,"W",0))
+11 FOR I=1:1:J
SET CNT=CNT+1
SET @TARGET@(CNT,0)=" "_$GET(^UTILITY($JOB,"W",0,I,0))
+12 KILL ^UTILITY($JOB,"W")
+13 SET CNT=CNT+1
+14 SET @TARGET@(CNT,0)=""
+15 SET CNT=CNT+1
+16 SET @TARGET@(CNT,0)="Provider: "_PROVNAME
+17 SET CNT=CNT+1
+18 SET @TARGET@(CNT,0)=DASH
+19 QUIT
EYE(DFN,TARGET) ;print RX
FNUM() QUIT 9000010.04
STRING() NEW STR,VAL,I
+1 SET STR=""
+2 FOR I=1:1:62
SET STR=STR_"-"
+3 SET VAL=STR
+4 QUIT VAL
