- 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 Jan 18, 2025@02:56:29 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