- DG1010P ;ALB/JDS;REW - 1010 PRINT--INQUIRY PATIENT ; 1/3/05 6:18pm
- ;;5.3;Registration;**86,108,113,161,642,624**;Aug 13, 1993
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1010P 6026 printed Feb 19, 2025@00:01:08 Page 2
- DG1010P ;ALB/JDS;REW - 1010 PRINT--INQUIRY PATIENT ; 1/3/05 6:18pm
- +1 ;;5.3;Registration;**86,108,113,161,642,624**;Aug 13, 1993
- +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 DO 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