DG1010P ;ALB/JDS;REW - 1010 PRINT--INQUIRY PATIENT ; 1/3/05 6:18pm
;;5.3;Registration;**86,108,113,161,642,624,1015**;Aug 13, 1993;Build 21
;
FIND W !! S DIC="^DPT(",DIC(0)="AEQZM" D ^DIC G Q:+Y'>0 S (DA,DFN)=+Y
S DFN1=0
I $O(^DPT(DFN,"DIS",0))>0 S DFN1=$O(^DPT(DFN,"DIS",0))
W1 D NOREG^DG1010PA(DFN)
QU ;
S DGHDFN=DFN
I DGOPT]"" D
. N EAPP,EAIP
. S (EAPP,EAIP)=0 F S EAPP=$O(^EAS(712,"AC",DFN,EAPP)) Q:'EAPP!EAIP D
. . I $$GET1^DIQ(712,EAPP,7.1)="" D
. . . N EAIX,EADT F EAIX="REV","PRT","SIG" Q:EAIP D
. . . . S EADT=0 F S EADT=$O(^EAS(712,EAIX,EADT)) Q:'EADT!EAIP I $D(^EAS(712,EAIX,EADT,EAPP)) S EAIP=1
. I EAIP D Q
. . N DIR
. . W !!,"No data have been found for the selected patient, or"
. . W !,"the patient may have an on-line 10-10EZ application"
. . W !,"in progress. The 10-10EZ form shall not be printed."
. . S DIR(0)="E" D ^DIR
. . S DGOPT=""
I DGOPT]"" D S DGPGM="DQ^DG1010P",DGVAR="DGOPT^PRF^DFN^DFN1^DUZ^DGPMDA^PSOINST^PSONOPG^PSOPAR^PSTYPE^GMTSTYP^EASMTIEN" D ZIS^DGUTQ G:POP EMB U IO D DQ G EMB
.W:DGOPT'=5 !!?5,*7,"This output requires 132 column output to a PRINTER.",!?5,*7,"Output to SCREEN will be unreadable."
G EMB
EN ;
Q
DQ ;
D NOW^%DTC,YX^%DTC S DGNOW=Y
S X=132 X ^%ZOSF("RM") F I="DFN","DFN1","DGPMDA","PRF","GMTSTYP" S DGHOLD(I)=$S($D(@I):@I,1:"")
I DGOPT[0&'($G(DGSTOP)) DO
. S (EASDFN,DA)=DFN,ZUSR=DUZ
. D EN^EASEZPDG ;1010EZ
. K EASDFN,ZUSR,EASMTIEN
I DGOPT[1&'($G(DGSTOP)) DO
. S (EASDFN,DA)=DFN,EASFLAG="EZR",ZUSR=DUZ
. D EN^EASEZPDG ;1010EZR
. K EASFLAG,EASDFN,ZUSR,EASMTIEN
I DGOPT[3&'($G(DGSTOP)) D RESTORE,RET^DGBLRV ;3rd party review
I DGOPT[8&'($G(DGSTOP)) D RESTORE,ENXQ^GMTSDVR
I DGOPT[5&'($G(DGSTOP)) S POP=0 D RESTORE,DFN^PSOSD1 K POP S X=132 X ^%ZOSF("RM") ;DRUG PROFILE NOTE: EXECUTES ^%ZIS("C")
D ^%ZISC
D CLOSE^DGUTQ,Q K DGHOLD,DGOPT,DGPMDA Q
Q K %,%DT,DA,DB,DFN,DFN1,DGHSFLG,DGOPT,DGL2,DGLDASH,DGLDOUBL,DGLSUP,DGLSUP1,DGLUND,DGPGM,DGPMDA,DGMTDT,DGMTI,DGMTYPT,DGNOW,DGVAR,DGX,DIC,DIRUT,DTOUT,DUOUT,I,J,L,POP,PRF,X,Y,DGSTOP
K LMI,PSCNT,PSDIS,PSDT,PSII,PSOPRINT ;FROM DRUG PROFILE
K GMTSTYP,EASMTIEN
Q
RESTORE F I="DFN","DFN1","PRF","DGPMDA","GMTSTYP" S @I=DGHOLD(I)
Q
EMB ;emboss card?
S DFN=DGHDFN
;W !! D EMBOS^DGQEMA
D EF
K DGHDFN G FIND
;
EF ;encounter form?
N EFX,WITHDATA,IBDFRION
I $$PROMPRN^DG1010PA("EF") I DG1'<0 S EFX=1 D
.S WITHDATA=1
.;D MAIN^IBDFREG(WITHDATA)
Q
;
SEL1010(PROMPT) ;* Prompt user to select the 1010EZ to print
;
; INPUT:
; PROMPT : Indicate which prompts to present
; : NULL - Prompt both (EZ prompted 1st)
; : EZ - Prompt 1010EZ only
; : EZR/EZ - Prompt both (EZR prompted 1st)
; : EZR - Prompt 1010EZR only
;
; OUTPUT
; RPTSEL : NULL - No report selected
; : "EZ" - 1010EZ report was selected
; : "EZR" - 1010EZR report was selected
;
N PRT1010,PRT1010R,RPTSEL
I '$D(PROMPT) S PROMPT=""
S PRT1010=0
S PRT1010R=0
S RPTSEL=""
;
;* Prompt 1010EZ and then 1010EZR
I PROMPT="" DO
. S PRT1010=$$EZPRMPT
. I PRT1010 S RPTSEL="EZ"
. S:PRT1010=0 PRT1010R=$$EZRPRMPT
. I PRT1010R S RPTSEL="EZR"
. I (PRT1010=-2)!(PRT1010R=-2) S RPTSEL=-1
;
;* Prompt 1010EZR and then 1010EZ
I PROMPT="EZR/EZ" DO
. S PRT1010R=$$EZRPRMPT
. I PRT1010R S RPTSEL="EZR"
. S:PRT1010R=0 PRT1010=$$EZPRMPT
. I PRT1010 S RPTSEL="EZ"
. I (PRT1010=-2)!(PRT1010R=-2) S RPTSEL=-1
;
;* Prompt 1010EZ only
I PROMPT="EZ" DO
. S PRT1010=$$EZPRMPT
. I PRT1010 S RPTSEL="EZ"
. I (PRT1010=-2) S RPTSEL=-1
;
;* Prompt 1010EZR only
I PROMPT="EZR" DO
. S PRT1010R=$$EZRPRMPT
. I PRT1010R S RPTSEL="EZR"
. I (PRT1010R=-2) S RPTSEL=-1
;
Q RPTSEL
;
EZPRMPT() ;* Prompt for 1010EZ print
; OUTPUT -
; RPTSEL : -1 REPORT NOT SELECTED
; RPTSEL : -2 USER EXITED WITHOUT RESPONSE
; RPTSEL : 0 USER ANSWERED "NO"
; RPTSEL : 1 USER ANSWERED "YES"
;
N RPTSEL,PRT1010
S RPTSEL=-1
K DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
S DIR(0)="Y^A0^"
S DIR("A")="PRINT 10-10EZ"
S DIR("?",1)="Enter 'Yes' to print a 10-10EZ Application for Health Benefits form."
S DIR("?")="Otherwise enter 'No'."
S DIR("B")="YES"
D ^DIR
I $D(DIRUT)!$D(DTOUT)!$D(DIROUT)!$D(DUOUT) S RPTSEL=-2
S:RPTSEL'=-2 RPTSEL=Y
;;S PRT1010=Y
;;I PRT1010 S RPTSEL="EZ"
K DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
Q RPTSEL
;
EZRPRMPT() ;* Prompt for 1010EZR print
; OUTPUT -
; RPTSEL : -1 REPORT NOT SELECTED
; RPTSEL : -2 USER EXITED WITHOUT RESPONSE
; RPTSEL : 0 USER ANSWERED "NO"
; RPTSEL : 1 USER ANSWERED "YES"
;
N RPTSEL,PRT1010R
S RPTSEL=-1
K DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
S DIR(0)="Y^A0^"
S DIR("A")="PRINT 10-10EZR"
S DIR("?",1)="Enter 'YES' to print a 10-10EZR Health Benefits Renewal form."
S DIR("?")="Otherwise enter 'No'."
S DIR("B")="YES"
D ^DIR
I $D(DIRUT)!$D(DTOUT)!$D(DIROUT)!$D(DUOUT) S RPTSEL=-2
S:RPTSEL'=-2 RPTSEL=Y
;;S PRT1010R=Y
;;I PRT1010R S RPTSEL="EZR"
K DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
Q RPTSEL
;
MTPRMPT(DFN,DGMTI) ;* Prompt for Means test included on 1010EZ
;input:
; DFN - Patient file (#2) ien (required)
; DGMTI - Means Test file (#408.31) ien (required)
;output:
; MTSEL - Means Test IEN selected
N MTSEL
S MTSEL=+DGMTI
I $D(^DGMT(408.31,MTSEL,0)) Q MTSEL
Q $$ENEZ^EASEZPDG(DFN,0)
;
PRT1010(PRT1010,DFN,MTIEN) ;* Print 1010EZ reports
;INPUT:
; PRT1010 -
; "EZ": Print 1010EZ report
; "EZR": Print 1010EZR report
; DFN - IEN from Patient entry in Patient file
; MTIEN - IEN from 408.31 Means Test file
;
;OUTPUT:
; DGTASK : Value of ZTSK passed back from ^%ZTLOAD in EASEZPDG
; : 0 indicates print task was not completed
;
N DGTASK
S DGTASK=0
;* Following calls allowed via IA #4600
I PRT1010="EZ" S DGTASK=$$ENEZ^EASEZPDG(DFN,MTIEN)
I PRT1010="EZR" S DGTASK=$$ENEZR^EASEZPDG(DFN,MTIEN)
Q DGTASK
DG1010P ;ALB/JDS;REW - 1010 PRINT--INQUIRY PATIENT ; 1/3/05 6:18pm
+1 ;;5.3;Registration;**86,108,113,161,642,624,1015**;Aug 13, 1993;Build 21
+2 ;
FIND WRITE !!
SET DIC="^DPT("
SET DIC(0)="AEQZM"
DO ^DIC
IF +Y'>0
GOTO Q
SET (DA,DFN)=+Y
+1 SET DFN1=0
+2 IF $ORDER(^DPT(DFN,"DIS",0))>0
SET DFN1=$ORDER(^DPT(DFN,"DIS",0))
W1 DO NOREG^DG1010PA(DFN)
QU ;
+1 SET DGHDFN=DFN
+2 IF DGOPT]""
Begin DoDot:1
+3 NEW EAPP,EAIP
+4 SET (EAPP,EAIP)=0
FOR
SET EAPP=$ORDER(^EAS(712,"AC",DFN,EAPP))
IF 'EAPP!EAIP
QUIT
Begin DoDot:2
+5 IF $$GET1^DIQ(712,EAPP,7.1)=""
Begin DoDot:3
+6 NEW EAIX,EADT
FOR EAIX="REV","PRT","SIG"
IF EAIP
QUIT
Begin DoDot:4
+7 SET EADT=0
FOR
SET EADT=$ORDER(^EAS(712,EAIX,EADT))
IF 'EADT!EAIP
QUIT
IF $DATA(^EAS(712,EAIX,EADT,EAPP))
SET EAIP=1
End DoDot:4
End DoDot:3
End DoDot:2
+8 IF EAIP
Begin DoDot:2
+9 NEW DIR
+10 WRITE !!,"No data have been found for the selected patient, or"
+11 WRITE !,"the patient may have an on-line 10-10EZ application"
+12 WRITE !,"in progress. The 10-10EZ form shall not be printed."
+13 SET DIR(0)="E"
DO ^DIR
+14 SET DGOPT=""
End DoDot:2
QUIT
End DoDot:1
+15 IF DGOPT]""
Begin DoDot:1
+16 IF DGOPT'=5
WRITE !!?5,*7,"This output requires 132 column output to a PRINTER.",!?5,*7,"Output to SCREEN will be unreadable."
End DoDot:1
SET DGPGM="DQ^DG1010P"
SET DGVAR="DGOPT^PRF^DFN^DFN1^DUZ^DGPMDA^PSOINST^PSONOPG^PSOPAR^PSTYPE^GMTSTYP^EASMTIEN"
DO ZIS^DGUTQ
IF POP
GOTO EMB
USE IO
DO DQ
GOTO EMB
+17 GOTO EMB
EN ;
+1 QUIT
DQ ;
+1 DO NOW^%DTC
DO YX^%DTC
SET DGNOW=Y
+2 SET X=132
XECUTE ^%ZOSF("RM")
FOR I="DFN","DFN1","DGPMDA","PRF","GMTSTYP"
SET DGHOLD(I)=$SELECT($DATA(@I):@I,1:"")
+3 IF DGOPT[0&'($GET(DGSTOP))
Begin DoDot:1
+4 SET (EASDFN,DA)=DFN
SET ZUSR=DUZ
+5 ;1010EZ
DO EN^EASEZPDG
+6 KILL EASDFN,ZUSR,EASMTIEN
End DoDot:1
+7 IF DGOPT[1&'($GET(DGSTOP))
Begin DoDot:1
+8 SET (EASDFN,DA)=DFN
SET EASFLAG="EZR"
SET ZUSR=DUZ
+9 ;1010EZR
DO EN^EASEZPDG
+10 KILL EASFLAG,EASDFN,ZUSR,EASMTIEN
End DoDot:1
+11 ;3rd party review
IF DGOPT[3&'($GET(DGSTOP))
DO RESTORE
DO RET^DGBLRV
+12 IF DGOPT[8&'($GET(DGSTOP))
DO RESTORE
DO ENXQ^GMTSDVR
+13 ;DRUG PROFILE NOTE: EXECUTES ^%ZIS("C")
IF DGOPT[5&'($GET(DGSTOP))
SET POP=0
DO RESTORE
DO DFN^PSOSD1
KILL POP
SET X=132
XECUTE ^%ZOSF("RM")
+14 DO ^%ZISC
+15 DO CLOSE^DGUTQ
DO Q
KILL DGHOLD,DGOPT,DGPMDA
QUIT
Q KILL %,%DT,DA,DB,DFN,DFN1,DGHSFLG,DGOPT,DGL2,DGLDASH,DGLDOUBL,DGLSUP,DGLSUP1,DGLUND,DGPGM,DGPMDA,DGMTDT,DGMTI,DGMTYPT,DGNOW,DGVAR,DGX,DIC,DIRUT,DTOUT,DUOUT,I,J,L,POP,PRF,X,Y,DGSTOP
+1 ;FROM DRUG PROFILE
KILL LMI,PSCNT,PSDIS,PSDT,PSII,PSOPRINT
+2 KILL GMTSTYP,EASMTIEN
+3 QUIT
RESTORE FOR I="DFN","DFN1","PRF","DGPMDA","GMTSTYP"
SET @I=DGHOLD(I)
+1 QUIT
EMB ;emboss card?
+1 SET DFN=DGHDFN
+2 ;W !! D EMBOS^DGQEMA
+3 DO EF
+4 KILL DGHDFN
GOTO FIND
+5 ;
EF ;encounter form?
+1 NEW EFX,WITHDATA,IBDFRION
+2 IF $$PROMPRN^DG1010PA("EF")
IF DG1'<0
SET EFX=1
Begin DoDot:1
+3 SET WITHDATA=1
+4 ;D MAIN^IBDFREG(WITHDATA)
End DoDot:1
+5 QUIT
+6 ;
SEL1010(PROMPT) ;* Prompt user to select the 1010EZ to print
+1 ;
+2 ; INPUT:
+3 ; PROMPT : Indicate which prompts to present
+4 ; : NULL - Prompt both (EZ prompted 1st)
+5 ; : EZ - Prompt 1010EZ only
+6 ; : EZR/EZ - Prompt both (EZR prompted 1st)
+7 ; : EZR - Prompt 1010EZR only
+8 ;
+9 ; OUTPUT
+10 ; RPTSEL : NULL - No report selected
+11 ; : "EZ" - 1010EZ report was selected
+12 ; : "EZR" - 1010EZR report was selected
+13 ;
+14 NEW PRT1010,PRT1010R,RPTSEL
+15 IF '$DATA(PROMPT)
SET PROMPT=""
+16 SET PRT1010=0
+17 SET PRT1010R=0
+18 SET RPTSEL=""
+19 ;
+20 ;* Prompt 1010EZ and then 1010EZR
+21 IF PROMPT=""
Begin DoDot:1
+22 SET PRT1010=$$EZPRMPT
+23 IF PRT1010
SET RPTSEL="EZ"
+24 IF PRT1010=0
SET PRT1010R=$$EZRPRMPT
+25 IF PRT1010R
SET RPTSEL="EZR"
+26 IF (PRT1010=-2)!(PRT1010R=-2)
SET RPTSEL=-1
End DoDot:1
+27 ;
+28 ;* Prompt 1010EZR and then 1010EZ
+29 IF PROMPT="EZR/EZ"
Begin DoDot:1
+30 SET PRT1010R=$$EZRPRMPT
+31 IF PRT1010R
SET RPTSEL="EZR"
+32 IF PRT1010R=0
SET PRT1010=$$EZPRMPT
+33 IF PRT1010
SET RPTSEL="EZ"
+34 IF (PRT1010=-2)!(PRT1010R=-2)
SET RPTSEL=-1
End DoDot:1
+35 ;
+36 ;* Prompt 1010EZ only
+37 IF PROMPT="EZ"
Begin DoDot:1
+38 SET PRT1010=$$EZPRMPT
+39 IF PRT1010
SET RPTSEL="EZ"
+40 IF (PRT1010=-2)
SET RPTSEL=-1
End DoDot:1
+41 ;
+42 ;* Prompt 1010EZR only
+43 IF PROMPT="EZR"
Begin DoDot:1
+44 SET PRT1010R=$$EZRPRMPT
+45 IF PRT1010R
SET RPTSEL="EZR"
+46 IF (PRT1010R=-2)
SET RPTSEL=-1
End DoDot:1
+47 ;
+48 QUIT RPTSEL
+49 ;
EZPRMPT() ;* Prompt for 1010EZ print
+1 ; OUTPUT -
+2 ; RPTSEL : -1 REPORT NOT SELECTED
+3 ; RPTSEL : -2 USER EXITED WITHOUT RESPONSE
+4 ; RPTSEL : 0 USER ANSWERED "NO"
+5 ; RPTSEL : 1 USER ANSWERED "YES"
+6 ;
+7 NEW RPTSEL,PRT1010
+8 SET RPTSEL=-1
+9 KILL DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
+10 SET DIR(0)="Y^A0^"
+11 SET DIR("A")="PRINT 10-10EZ"
+12 SET DIR("?",1)="Enter 'Yes' to print a 10-10EZ Application for Health Benefits form."
+13 SET DIR("?")="Otherwise enter 'No'."
+14 SET DIR("B")="YES"
+15 DO ^DIR
+16 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
SET RPTSEL=-2
+17 IF RPTSEL'=-2
SET RPTSEL=Y
+18 ;;S PRT1010=Y
+19 ;;I PRT1010 S RPTSEL="EZ"
+20 KILL DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
+21 QUIT RPTSEL
+22 ;
EZRPRMPT() ;* Prompt for 1010EZR print
+1 ; OUTPUT -
+2 ; RPTSEL : -1 REPORT NOT SELECTED
+3 ; RPTSEL : -2 USER EXITED WITHOUT RESPONSE
+4 ; RPTSEL : 0 USER ANSWERED "NO"
+5 ; RPTSEL : 1 USER ANSWERED "YES"
+6 ;
+7 NEW RPTSEL,PRT1010R
+8 SET RPTSEL=-1
+9 KILL DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
+10 SET DIR(0)="Y^A0^"
+11 SET DIR("A")="PRINT 10-10EZR"
+12 SET DIR("?",1)="Enter 'YES' to print a 10-10EZR Health Benefits Renewal form."
+13 SET DIR("?")="Otherwise enter 'No'."
+14 SET DIR("B")="YES"
+15 DO ^DIR
+16 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
SET RPTSEL=-2
+17 IF RPTSEL'=-2
SET RPTSEL=Y
+18 ;;S PRT1010R=Y
+19 ;;I PRT1010R S RPTSEL="EZR"
+20 KILL DIR,Y,X,DIRUT,DTOUT,DIROUT,DUOUT
+21 QUIT RPTSEL
+22 ;
MTPRMPT(DFN,DGMTI) ;* Prompt for Means test included on 1010EZ
+1 ;input:
+2 ; DFN - Patient file (#2) ien (required)
+3 ; DGMTI - Means Test file (#408.31) ien (required)
+4 ;output:
+5 ; MTSEL - Means Test IEN selected
+6 NEW MTSEL
+7 SET MTSEL=+DGMTI
+8 IF $DATA(^DGMT(408.31,MTSEL,0))
QUIT MTSEL
+9 QUIT $$ENEZ^EASEZPDG(DFN,0)
+10 ;
PRT1010(PRT1010,DFN,MTIEN) ;* Print 1010EZ reports
+1 ;INPUT:
+2 ; PRT1010 -
+3 ; "EZ": Print 1010EZ report
+4 ; "EZR": Print 1010EZR report
+5 ; DFN - IEN from Patient entry in Patient file
+6 ; MTIEN - IEN from 408.31 Means Test file
+7 ;
+8 ;OUTPUT:
+9 ; DGTASK : Value of ZTSK passed back from ^%ZTLOAD in EASEZPDG
+10 ; : 0 indicates print task was not completed
+11 ;
+12 NEW DGTASK
+13 SET DGTASK=0
+14 ;* Following calls allowed via IA #4600
+15 IF PRT1010="EZ"
SET DGTASK=$$ENEZ^EASEZPDG(DFN,MTIEN)
+16 IF PRT1010="EZR"
SET DGTASK=$$ENEZR^EASEZPDG(DFN,MTIEN)
+17 QUIT DGTASK
