EASEZU3 ;ALB/jap - Utilities for 1010EZ Processing ; 11/6/09 1:25pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,57,92**;Mar 15, 2001;Build 20
;
NSD(EASAPP,TYPE,MULTIPLE) ;get name, ssn, dob for person of interest
;input EASAPP = application ien in file #712
; TYPE = "APPLICANT", "SPOUSE", "CHILD1", or "CHILD(N)"
; MULTIPLE = default to 1, unless TYPE="CHILD(N)"
;output RTR = name^ssn^dob
N RTR,KEY,EASNAME,EASSSN,EASDOB,LAST,FIRST,MDL,SUFF
S RTR="",EASNAME="",EASSSN="",EASDOB=""
S KEY=+$$KEY711^EASEZU1(TYPE_" LAST NAME") I KEY S LAST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
S KEY=+$$KEY711^EASEZU1(TYPE_" FIRST NAME") I KEY S FIRST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
S KEY=+$$KEY711^EASEZU1(TYPE_" MIDDLE NAME") I KEY S MDL=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
S KEY=+$$KEY711^EASEZU1(TYPE_" SUFFIX NAME") I KEY S SUFF=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
I (LAST="")!(FIRST="") Q RTR
S EASNAME=LAST_","_FIRST
I $L(EASNAME)+$L(MDL)>45 S MDL=$E(MDL,1)
I MDL'="" S EASNAME=EASNAME_" "_MDL
I SUFF'="" S EASNAME=EASNAME_" "_SUFF
S EASNAME=$$UC^EASEZT1($E(EASNAME,1,45))
S KEY=+$$KEY711^EASEZU1(TYPE_" SOCIAL SECURITY NUMBER")
I KEY S EASSSN=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1),EASSSN=$$SSNOUT^EASEZT1(EASSSN)
S KEY=+$$KEY711^EASEZU1(TYPE_" DATE OF BIRTH")
I KEY S EASDOB=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
S RTR=EASNAME_U_EASSSN_U_EASDOB
Q RTR
;
LINK ;
;link applicant to file #2 as new or existing patient
Q:EASVIEW'=1
S EASPSTAT="NEW"
D DFN^EASEZI(EASAPP,.EASDFN)
I $G(EASDFN)>0 D
.D SETDATE^EASEZU2(EASAPP,"REV") S EASPSTAT="REV"
.D BLD^EASEZLM
.W ! D WAIT^DICD,EN^VALM("EAS EZ 1010EZ REVIEW2")
.S VALMBCK="Q"
I '$G(EASDFN) S VALMBCK="R"
Q
;
ACCFLD ;accept a single 1010EZ data element
;if data element was previously accepted, this action returns to non-accepted status
;input EASAPP = pointer to file #712 for 1010EZ
; EASPSTAT = current processing status of Application;
;result ACCEPT = 1, if toggled to accepted
; 0, if toggled to non-accepted
N J,LN,SUBIEN,KEYIEN,MULTIPLE,ACCEPT,ACTION,LINK,ONE
Q:'EASAPP Q:EASPSTAT=""
Q:'EASLN
S ACTION="'Accept Field'"
I EASPSTAT="PRT" D NOACT^EASEZLM("Printed",ACTION) Q
I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
;select data item to toggle
S VALMBCK=""
S ONE=0
S VALM("ENTITY")="Line Item" D SELRNGE^EASEZLM
Q:$G(EASERR)
Q:'$G(EASSEL("BG"))
;
I EASSEL("BG")=EASSEL("LST") S ONE=1
;
S J=0 F S J=$O(EASSEL(J)) Q:'J S EASLN=J D
.S LN=$G(^TMP("EASEXP",$J,"IDX",EASLN))
.Q:LN=""
.S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
.S EZDATA=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1),XFILE=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,1)
.Q:EZDATA=""
.Q:'SUBIEN
.S ACCEPT=$P($G(^EAS(712,EASAPP,10,SUBIEN,0)),U,3)
.;provide info to user only if exactly one line item being 'accepted'
.I ONE D FULL^VALM1
.;
.;Block acceptance of Military Service fields if ESR data exists
.I ONE,KEYIEN>27,KEYIEN<33,$$ESRDATA^DGMSEUTL(EASDFN) D Q
..W !!,?5
..W "Sorry, that data element cannot be 'Accepted' for 'Filing'."
..W !!,?5
..W "Authoritative ESR data for military service exists."
..W !!,?5
..W "After filing this Application to VistA, use Register a Patient "
..W !,?5,"or Patient Enrollment to enter/update data as needed.",!
..K DIR D PAUSE^VALM1 S VALMBCK="R"
.;
.;don't allow accept of data which cannot be filed
.I ((XFILE=0)!(ACCEPT=-1)) D:ONE Q
..W !!,?5,"Sorry, that data element cannot be 'Accepted' for 'Filing'."
..W !!,?5,"After filing this Application to VistA, use Register a Patient "
..W !,?5,"or Patient Enrollment to enter/update data as needed.",!
..K DIR D PAUSE^VALM1 S VALMBCK="R"
.;if an 'always' accept data element, don't allow user to toggle off;
.I ACCEPT=2 D:ONE Q
..W !!,?5,"Sorry, that data element must be 'Accepted' for this Applicant."
..I XFILE'=355.33 D
...W !!,?5,"After filing this Application to VistA, the Registration options"
...W !,?5,"can be used to modify data as needed.",!
..I XFILE=355.33 D
...W !!,?5,"After filing this Application to VistA, Integrated Billing users"
...W !,?5,"can modify the data using the 'Process Insurance Buffer' option.",!
..K DIR D PAUSE^VALM1 S VALMBCK="R"
.;don't allow 'updated' element to be toggled off;
.S UPD=$P($G(^EAS(712,EASAPP,10,SUBIEN,1)),U,2) I UPD'="" D:ONE Q
..W !!,?5,"Sorry, that data element has been Updated and must be 'Accepted'"
..W !,?5,"for this Applicant."
..K DIR D PAUSE^VALM1 S VALMBCK="R"
.;toggle 'accept' indicator for line itme
.S ACCEPT=$$ATOGGLE(EASLN,SUBIEN,ACCEPT)
;
Q
;
ATOGGLE(EASLN,SUBIEN,ACCEPT) ;toggle 'accept' on line item
S ACCEPT='ACCEPT
S $P(^EAS(712,EASAPP,10,SUBIEN,0),U,3)=ACCEPT
;highlight data on screen
I ACCEPT D CNTRL^VALM10(EASLN,27,25,IORVON,IORVOFF)
I 'ACCEPT D CNTRL^VALM10(EASLN,27,25,IORVOFF,IORVOFF)
D WRITE^VALM10(EASLN)
S VALMBCK="R"
Q ACCEPT
;
ACCALL ;accept all non-null 1010EZ data elements
;prevously accepted data elements are not toggled to non-accepted
;input EASAPP = pointer to file #712 for 1010EZ
; EASPSTAT = current processing status of Application;
N EASLN,ACTION,XFILE
Q:'EASAPP Q:EASPSTAT=""
S ACTION="'Accept All'"
I EASPSTAT="PRT" D NOACT^EASEZLM("Printed",ACTION) Q
I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
;
S EASLN=0 F S EASLN=$O(^TMP("EASEXP",$J,"IDX",EASLN)) Q:'EASLN D
.S SUBIEN=$P(^TMP("EASEXP",$J,"IDX",EASLN),U,1),MULTIPLE=$P(^(EASLN),U,2),KEYIEN=$P(^(EASLN),U,3)
.S XFILE=$P(^TMP("EZDATA",$J,KEYIEN),U,1)
.Q:XFILE=0
.;Military service data excluded from accept all if ESR data exists
.I KEYIEN>27,KEYIEN<33,$$ESRDATA^DGMSEUTL(EASDFN) Q
.S EZDATA=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1) I EZDATA'="" D
..I $P(^EAS(712,EASAPP,10,SUBIEN,0),U,3)="" S $P(^(0),U,3)=1
..D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
..Q:(EASLN<VALMBG)!(EASLN>VALMLST)
..D CNTRL^VALM10(EASLN,27,25,IORVON,IORVOFF)
..D WRITE^VALM10(EASLN)
;
;update processing status if necessary
I EASPSTAT="NEW" D
.D SETDATE^EASEZU2(EASAPP,"REV") S EASPSTAT="REV"
.D BLD^EASEZLM,HDR2^EASEZL1
S VALMBCK="R"
Q
;
CLEAR ;clear all accept indicators from subfile #712.01 & LM array
;input EASAPP = ien to #712 for Application
; EASPSTAT = current processing status of Application;
N BB,EASLN,ACTION
Q:'EASAPP Q:EASPSTAT=""
S ACTION="'Clear All'"
I EASPSTAT="PRT" D NOACT^EASEZLM("Printed",ACTION) Q
I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
;
;if a new patient, don't allow user to reset all accept
I $G(EASEZNEW) D Q
.D FULL^VALM1
.W !!,?5,"Sorry, the 'Clear All' action cannot be used for this new patient."
.W !,?5,"It is recommended that all data elements be 'Accepted' for 'Filing'."
.W !!,?5,"After filing the Application to VistA, the Registration options"
.W !,?5,"can be used to modify data.",!
.D PAUSE^VALM1 S VALMBCK="R"
;
;clear accept flags and updates
;remove accept indicators from List Manager display array
S EASLN=0 F S EASLN=$O(^TMP("EASEXP",$J,"IDX",EASLN)) Q:'EASLN D
.S SUBIEN=$P(^TMP("EASEXP",$J,"IDX",EASLN),U,1)
.;don't clear if updated
.Q:'SUBIEN
.I $P($G(^EAS(712,EASAPP,10,SUBIEN,0)),U,3)=1 D
..F P=3,4,5 S $P(^EAS(712,EASAPP,10,SUBIEN,0),U,P)=""
..S $P(^EAS(712,EASAPP,10,SUBIEN,1),U,2)=""
..S $P(^EAS(712,EASAPP,10,SUBIEN,2),U,1)=""
..D FLDCTRL^VALM10(EASLN,"EZDATA",IORVOFF,IORVOFF)
..Q:(EASLN<VALMBG)!(EASLN>VALMLST)
..D CNTRL^VALM10(EASLN,27,25,IORVOFF,IORVOFF) D WRITE^VALM10(EASLN)
S VALMBCK=""
Q
;
RESET ;reset 1010EZ Application to 'new' processing status
;input EASAPP = pointer to file #712 for 1010EZ
; EASPSTAT = current processing status of Application;
;this action must be follwed by an 'exit' action from the List Manager screen
N ACTION,NEWDATE
Q:'EASAPP Q:EASPSTAT=""
S ACTION="'Reset to New'"
I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
;
D OKRESET
;update to 'New' status
S EASPSTAT="NEW",NEWDATE=$P(^EAS(712,EASAPP,0),U,6)
D REINDEX^EASEZU2(EASAPP,EASPSTAT,NEWDATE)
;rebuild selection list since this application is removed from list
D BLD^EASEZLM
I 'VALMCNT D NOLINES^EASEZLM
W !,"Application has been Reset to New...",!
D PAUSE^VALM1
S VALMBCK="Q"
Q
;
OKRESET ;perform all housekeeping to for 'reset to new' or 'inactivate'
N BB,DA,DR,DIE,REM
;remove status indicator fields from file #712 record
S DA=EASAPP,DIE="^EAS(712,"
S DR="5.1///^S X=""@"";5.2///^S X=""@"";6.1///^S X=""@"";6.2///^S X=""@"";8.1///^S X=""@"";8.2///^S X=""@"";"
D ^DIE
;
;delete link to file #2
I '$G(EASDFN) S EASDFN=$P(^EAS(712,EASAPP,0),U,10)
S $P(^EAS(712,EASAPP,0),U,10)=""
I $G(EASDFN) K ^EAS(712,"AC",EASDFN,EASAPP)
;remove all links to VistA datbase
;delete link, delete updated data, remove accept in each subfile #712.01 record
S BB=0 F S BB=$O(^EAS(712,EASAPP,10,BB)) Q:'BB D
.F P=3,4,5 S $P(^EAS(712,EASAPP,10,BB,0),U,P)=""
.S $P(^EAS(712,EASAPP,10,BB,1),U,2)=""
.F P=1,2 S $P(^EAS(712,EASAPP,10,BB,2),U,P)=""
;
;clear new patient indicator since applicant must be re-matched to VistA;
;but if this applicant is matched again with same new stub record in VistA,
; there's a comment in file #2/field #.091 to indicate the record was previously
; added by 1010EZ process
;update 'new patient' remark
I '$G(EASEZNEW) S EASEZNEW=$P(^EAS(712,EASAPP,0),U,11)
S $P(^EAS(712,EASAPP,0),U,11)=""
I EASEZNEW,EASDFN D
.S REM="New Patient record added by ELECTRONIC 10-10EZ."
.S DA=EASDFN,DIE="^DPT(",DR=".091///^S X=REM"
.D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZU3 10215 printed Oct 16, 2024@17:56:02 Page 2
EASEZU3 ;ALB/jap - Utilities for 1010EZ Processing ; 11/6/09 1:25pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,57,92**;Mar 15, 2001;Build 20
+2 ;
NSD(EASAPP,TYPE,MULTIPLE) ;get name, ssn, dob for person of interest
+1 ;input EASAPP = application ien in file #712
+2 ; TYPE = "APPLICANT", "SPOUSE", "CHILD1", or "CHILD(N)"
+3 ; MULTIPLE = default to 1, unless TYPE="CHILD(N)"
+4 ;output RTR = name^ssn^dob
+5 NEW RTR,KEY,EASNAME,EASSSN,EASDOB,LAST,FIRST,MDL,SUFF
+6 SET RTR=""
SET EASNAME=""
SET EASSSN=""
SET EASDOB=""
+7 SET KEY=+$$KEY711^EASEZU1(TYPE_" LAST NAME")
IF KEY
SET LAST=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+8 SET KEY=+$$KEY711^EASEZU1(TYPE_" FIRST NAME")
IF KEY
SET FIRST=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+9 SET KEY=+$$KEY711^EASEZU1(TYPE_" MIDDLE NAME")
IF KEY
SET MDL=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+10 SET KEY=+$$KEY711^EASEZU1(TYPE_" SUFFIX NAME")
IF KEY
SET SUFF=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+11 IF (LAST="")!(FIRST="")
QUIT RTR
+12 SET EASNAME=LAST_","_FIRST
+13 IF $LENGTH(EASNAME)+$LENGTH(MDL)>45
SET MDL=$EXTRACT(MDL,1)
+14 IF MDL'=""
SET EASNAME=EASNAME_" "_MDL
+15 IF SUFF'=""
SET EASNAME=EASNAME_" "_SUFF
+16 SET EASNAME=$$UC^EASEZT1($EXTRACT(EASNAME,1,45))
+17 SET KEY=+$$KEY711^EASEZU1(TYPE_" SOCIAL SECURITY NUMBER")
+18 IF KEY
SET EASSSN=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
SET EASSSN=$$SSNOUT^EASEZT1(EASSSN)
+19 SET KEY=+$$KEY711^EASEZU1(TYPE_" DATE OF BIRTH")
+20 IF KEY
SET EASDOB=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+21 SET RTR=EASNAME_U_EASSSN_U_EASDOB
+22 QUIT RTR
+23 ;
LINK ;
+1 ;link applicant to file #2 as new or existing patient
+2 if EASVIEW'=1
QUIT
+3 SET EASPSTAT="NEW"
+4 DO DFN^EASEZI(EASAPP,.EASDFN)
+5 IF $GET(EASDFN)>0
Begin DoDot:1
+6 DO SETDATE^EASEZU2(EASAPP,"REV")
SET EASPSTAT="REV"
+7 DO BLD^EASEZLM
+8 WRITE !
DO WAIT^DICD
DO EN^VALM("EAS EZ 1010EZ REVIEW2")
+9 SET VALMBCK="Q"
End DoDot:1
+10 IF '$GET(EASDFN)
SET VALMBCK="R"
+11 QUIT
+12 ;
ACCFLD ;accept a single 1010EZ data element
+1 ;if data element was previously accepted, this action returns to non-accepted status
+2 ;input EASAPP = pointer to file #712 for 1010EZ
+3 ; EASPSTAT = current processing status of Application;
+4 ;result ACCEPT = 1, if toggled to accepted
+5 ; 0, if toggled to non-accepted
+6 NEW J,LN,SUBIEN,KEYIEN,MULTIPLE,ACCEPT,ACTION,LINK,ONE
+7 if 'EASAPP
QUIT
if EASPSTAT=""
QUIT
+8 if 'EASLN
QUIT
+9 SET ACTION="'Accept Field'"
+10 IF EASPSTAT="PRT"
DO NOACT^EASEZLM("Printed",ACTION)
QUIT
+11 IF EASPSTAT="SIG"
DO NOACT^EASEZLM("Signed",ACTION)
QUIT
+12 IF EASPSTAT="FIL"
DO NOACT^EASEZLM("Filed",ACTION)
QUIT
+13 IF EASPSTAT="CLS"
DO NOACT^EASEZLM("Inactivated",ACTION)
QUIT
+14 ;select data item to toggle
+15 SET VALMBCK=""
+16 SET ONE=0
+17 SET VALM("ENTITY")="Line Item"
DO SELRNGE^EASEZLM
+18 if $GET(EASERR)
QUIT
+19 if '$GET(EASSEL("BG"))
QUIT
+20 ;
+21 IF EASSEL("BG")=EASSEL("LST")
SET ONE=1
+22 ;
+23 SET J=0
FOR
SET J=$ORDER(EASSEL(J))
if 'J
QUIT
SET EASLN=J
Begin DoDot:1
+24 SET LN=$GET(^TMP("EASEXP",$JOB,"IDX",EASLN))
+25 if LN=""
QUIT
+26 SET SUBIEN=$PIECE(LN,U,1)
SET MULTIPLE=$PIECE(LN,U,2)
SET KEYIEN=$PIECE(LN,U,3)
+27 SET EZDATA=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1)),U,1)
SET XFILE=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN)),U,1)
+28 if EZDATA=""
QUIT
+29 if 'SUBIEN
QUIT
+30 SET ACCEPT=$PIECE($GET(^EAS(712,EASAPP,10,SUBIEN,0)),U,3)
+31 ;provide info to user only if exactly one line item being 'accepted'
+32 IF ONE
DO FULL^VALM1
+33 ;
+34 ;Block acceptance of Military Service fields if ESR data exists
+35 IF ONE
IF KEYIEN>27
IF KEYIEN<33
IF $$ESRDATA^DGMSEUTL(EASDFN)
Begin DoDot:2
+36 WRITE !!,?5
+37 WRITE "Sorry, that data element cannot be 'Accepted' for 'Filing'."
+38 WRITE !!,?5
+39 WRITE "Authoritative ESR data for military service exists."
+40 WRITE !!,?5
+41 WRITE "After filing this Application to VistA, use Register a Patient "
+42 WRITE !,?5,"or Patient Enrollment to enter/update data as needed.",!
+43 KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:2
QUIT
+44 ;
+45 ;don't allow accept of data which cannot be filed
+46 IF ((XFILE=0)!(ACCEPT=-1))
if ONE
Begin DoDot:2
+47 WRITE !!,?5,"Sorry, that data element cannot be 'Accepted' for 'Filing'."
+48 WRITE !!,?5,"After filing this Application to VistA, use Register a Patient "
+49 WRITE !,?5,"or Patient Enrollment to enter/update data as needed.",!
+50 KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:2
QUIT
+51 ;if an 'always' accept data element, don't allow user to toggle off;
+52 IF ACCEPT=2
if ONE
Begin DoDot:2
+53 WRITE !!,?5,"Sorry, that data element must be 'Accepted' for this Applicant."
+54 IF XFILE'=355.33
Begin DoDot:3
+55 WRITE !!,?5,"After filing this Application to VistA, the Registration options"
+56 WRITE !,?5,"can be used to modify data as needed.",!
End DoDot:3
+57 IF XFILE=355.33
Begin DoDot:3
+58 WRITE !!,?5,"After filing this Application to VistA, Integrated Billing users"
+59 WRITE !,?5,"can modify the data using the 'Process Insurance Buffer' option.",!
End DoDot:3
+60 KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:2
QUIT
+61 ;don't allow 'updated' element to be toggled off;
+62 SET UPD=$PIECE($GET(^EAS(712,EASAPP,10,SUBIEN,1)),U,2)
IF UPD'=""
if ONE
Begin DoDot:2
+63 WRITE !!,?5,"Sorry, that data element has been Updated and must be 'Accepted'"
+64 WRITE !,?5,"for this Applicant."
+65 KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:2
QUIT
+66 ;toggle 'accept' indicator for line itme
+67 SET ACCEPT=$$ATOGGLE(EASLN,SUBIEN,ACCEPT)
End DoDot:1
+68 ;
+69 QUIT
+70 ;
ATOGGLE(EASLN,SUBIEN,ACCEPT) ;toggle 'accept' on line item
+1 SET ACCEPT='ACCEPT
+2 SET $PIECE(^EAS(712,EASAPP,10,SUBIEN,0),U,3)=ACCEPT
+3 ;highlight data on screen
+4 IF ACCEPT
DO CNTRL^VALM10(EASLN,27,25,IORVON,IORVOFF)
+5 IF 'ACCEPT
DO CNTRL^VALM10(EASLN,27,25,IORVOFF,IORVOFF)
+6 DO WRITE^VALM10(EASLN)
+7 SET VALMBCK="R"
+8 QUIT ACCEPT
+9 ;
ACCALL ;accept all non-null 1010EZ data elements
+1 ;prevously accepted data elements are not toggled to non-accepted
+2 ;input EASAPP = pointer to file #712 for 1010EZ
+3 ; EASPSTAT = current processing status of Application;
+4 NEW EASLN,ACTION,XFILE
+5 if 'EASAPP
QUIT
if EASPSTAT=""
QUIT
+6 SET ACTION="'Accept All'"
+7 IF EASPSTAT="PRT"
DO NOACT^EASEZLM("Printed",ACTION)
QUIT
+8 IF EASPSTAT="SIG"
DO NOACT^EASEZLM("Signed",ACTION)
QUIT
+9 IF EASPSTAT="FIL"
DO NOACT^EASEZLM("Filed",ACTION)
QUIT
+10 IF EASPSTAT="CLS"
DO NOACT^EASEZLM("Inactivated",ACTION)
QUIT
+11 ;
+12 SET EASLN=0
FOR
SET EASLN=$ORDER(^TMP("EASEXP",$JOB,"IDX",EASLN))
if 'EASLN
QUIT
Begin DoDot:1
+13 SET SUBIEN=$PIECE(^TMP("EASEXP",$JOB,"IDX",EASLN),U,1)
SET MULTIPLE=$PIECE(^(EASLN),U,2)
SET KEYIEN=$PIECE(^(EASLN),U,3)
+14 SET XFILE=$PIECE(^TMP("EZDATA",$JOB,KEYIEN),U,1)
+15 if XFILE=0
QUIT
+16 ;Military service data excluded from accept all if ESR data exists
+17 IF KEYIEN>27
IF KEYIEN<33
IF $$ESRDATA^DGMSEUTL(EASDFN)
QUIT
+18 SET EZDATA=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1)),U,1)
IF EZDATA'=""
Begin DoDot:2
+19 IF $PIECE(^EAS(712,EASAPP,10,SUBIEN,0),U,3)=""
SET $PIECE(^(0),U,3)=1
+20 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
+21 if (EASLN<VALMBG)!(EASLN>VALMLST)
QUIT
+22 DO CNTRL^VALM10(EASLN,27,25,IORVON,IORVOFF)
+23 DO WRITE^VALM10(EASLN)
End DoDot:2
End DoDot:1
+24 ;
+25 ;update processing status if necessary
+26 IF EASPSTAT="NEW"
Begin DoDot:1
+27 DO SETDATE^EASEZU2(EASAPP,"REV")
SET EASPSTAT="REV"
+28 DO BLD^EASEZLM
DO HDR2^EASEZL1
End DoDot:1
+29 SET VALMBCK="R"
+30 QUIT
+31 ;
CLEAR ;clear all accept indicators from subfile #712.01 & LM array
+1 ;input EASAPP = ien to #712 for Application
+2 ; EASPSTAT = current processing status of Application;
+3 NEW BB,EASLN,ACTION
+4 if 'EASAPP
QUIT
if EASPSTAT=""
QUIT
+5 SET ACTION="'Clear All'"
+6 IF EASPSTAT="PRT"
DO NOACT^EASEZLM("Printed",ACTION)
QUIT
+7 IF EASPSTAT="SIG"
DO NOACT^EASEZLM("Signed",ACTION)
QUIT
+8 IF EASPSTAT="FIL"
DO NOACT^EASEZLM("Filed",ACTION)
QUIT
+9 IF EASPSTAT="CLS"
DO NOACT^EASEZLM("Inactivated",ACTION)
QUIT
+10 ;
+11 ;if a new patient, don't allow user to reset all accept
+12 IF $GET(EASEZNEW)
Begin DoDot:1
+13 DO FULL^VALM1
+14 WRITE !!,?5,"Sorry, the 'Clear All' action cannot be used for this new patient."
+15 WRITE !,?5,"It is recommended that all data elements be 'Accepted' for 'Filing'."
+16 WRITE !!,?5,"After filing the Application to VistA, the Registration options"
+17 WRITE !,?5,"can be used to modify data.",!
+18 DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:1
QUIT
+19 ;
+20 ;clear accept flags and updates
+21 ;remove accept indicators from List Manager display array
+22 SET EASLN=0
FOR
SET EASLN=$ORDER(^TMP("EASEXP",$JOB,"IDX",EASLN))
if 'EASLN
QUIT
Begin DoDot:1
+23 SET SUBIEN=$PIECE(^TMP("EASEXP",$JOB,"IDX",EASLN),U,1)
+24 ;don't clear if updated
+25 if 'SUBIEN
QUIT
+26 IF $PIECE($GET(^EAS(712,EASAPP,10,SUBIEN,0)),U,3)=1
Begin DoDot:2
+27 FOR P=3,4,5
SET $PIECE(^EAS(712,EASAPP,10,SUBIEN,0),U,P)=""
+28 SET $PIECE(^EAS(712,EASAPP,10,SUBIEN,1),U,2)=""
+29 SET $PIECE(^EAS(712,EASAPP,10,SUBIEN,2),U,1)=""
+30 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVOFF,IORVOFF)
+31 if (EASLN<VALMBG)!(EASLN>VALMLST)
QUIT
+32 DO CNTRL^VALM10(EASLN,27,25,IORVOFF,IORVOFF)
DO WRITE^VALM10(EASLN)
End DoDot:2
End DoDot:1
+33 SET VALMBCK=""
+34 QUIT
+35 ;
RESET ;reset 1010EZ Application to 'new' processing status
+1 ;input EASAPP = pointer to file #712 for 1010EZ
+2 ; EASPSTAT = current processing status of Application;
+3 ;this action must be follwed by an 'exit' action from the List Manager screen
+4 NEW ACTION,NEWDATE
+5 if 'EASAPP
QUIT
if EASPSTAT=""
QUIT
+6 SET ACTION="'Reset to New'"
+7 IF EASPSTAT="SIG"
DO NOACT^EASEZLM("Signed",ACTION)
QUIT
+8 IF EASPSTAT="FIL"
DO NOACT^EASEZLM("Filed",ACTION)
QUIT
+9 IF EASPSTAT="CLS"
DO NOACT^EASEZLM("Inactivated",ACTION)
QUIT
+10 ;
+11 DO OKRESET
+12 ;update to 'New' status
+13 SET EASPSTAT="NEW"
SET NEWDATE=$PIECE(^EAS(712,EASAPP,0),U,6)
+14 DO REINDEX^EASEZU2(EASAPP,EASPSTAT,NEWDATE)
+15 ;rebuild selection list since this application is removed from list
+16 DO BLD^EASEZLM
+17 IF 'VALMCNT
DO NOLINES^EASEZLM
+18 WRITE !,"Application has been Reset to New...",!
+19 DO PAUSE^VALM1
+20 SET VALMBCK="Q"
+21 QUIT
+22 ;
OKRESET ;perform all housekeeping to for 'reset to new' or 'inactivate'
+1 NEW BB,DA,DR,DIE,REM
+2 ;remove status indicator fields from file #712 record
+3 SET DA=EASAPP
SET DIE="^EAS(712,"
+4 SET DR="5.1///^S X=""@"";5.2///^S X=""@"";6.1///^S X=""@"";6.2///^S X=""@"";8.1///^S X=""@"";8.2///^S X=""@"";"
+5 DO ^DIE
+6 ;
+7 ;delete link to file #2
+8 IF '$GET(EASDFN)
SET EASDFN=$PIECE(^EAS(712,EASAPP,0),U,10)
+9 SET $PIECE(^EAS(712,EASAPP,0),U,10)=""
+10 IF $GET(EASDFN)
KILL ^EAS(712,"AC",EASDFN,EASAPP)
+11 ;remove all links to VistA datbase
+12 ;delete link, delete updated data, remove accept in each subfile #712.01 record
+13 SET BB=0
FOR
SET BB=$ORDER(^EAS(712,EASAPP,10,BB))
if 'BB
QUIT
Begin DoDot:1
+14 FOR P=3,4,5
SET $PIECE(^EAS(712,EASAPP,10,BB,0),U,P)=""
+15 SET $PIECE(^EAS(712,EASAPP,10,BB,1),U,2)=""
+16 FOR P=1,2
SET $PIECE(^EAS(712,EASAPP,10,BB,2),U,P)=""
End DoDot:1
+17 ;
+18 ;clear new patient indicator since applicant must be re-matched to VistA;
+19 ;but if this applicant is matched again with same new stub record in VistA,
+20 ; there's a comment in file #2/field #.091 to indicate the record was previously
+21 ; added by 1010EZ process
+22 ;update 'new patient' remark
+23 IF '$GET(EASEZNEW)
SET EASEZNEW=$PIECE(^EAS(712,EASAPP,0),U,11)
+24 SET $PIECE(^EAS(712,EASAPP,0),U,11)=""
+25 IF EASEZNEW
IF EASDFN
Begin DoDot:1
+26 SET REM="New Patient record added by ELECTRONIC 10-10EZ."
+27 SET DA=EASDFN
SET DIE="^DPT("
SET DR=".091///^S X=REM"
+28 DO ^DIE
End DoDot:1
+29 QUIT
