- EASEZLM ;ALB/jap - 1010EZ List Manager Processing Screens ;10/12/00 13:07
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;;Mar 15, 2001
- ;
- EN ;Main entry point for 1010EZ processing
- ;Ask user to select processing status
- W @IOF
- W !!,"10-10EZ Application Processing --",!
- K DIR,DTOUT,DUOUT,DIRUT,Y
- S DIR(0)="SMO^1:New;2:In Review;3:Printed, Pending Signature;4:Signed;5:Filed;6:Inactivated"
- S DIR("A")="Select Applications to View"
- D ^DIR K DIR
- I $D(DIRUT) K DIR,DTOUT,DUOUT,DIRUT,Y Q
- ;
- S EASVIEW=0
- ;I Y,"^1^2^3^4^5^"[(U_Y_U) S EASVIEW=Y
- I Y,"^1^2^3^4^5^6^"[(U_Y_U) S EASVIEW=Y
- Q:'EASVIEW
- S EASPSTAT=""
- D EN^EASEZL1
- K EASVIEW G EN
- Q
- ;
- HDR ;Header code
- N H
- S VALMHDR(1)=" "
- ;Processing - primary view
- N HDR
- S HDR=""
- S H=$S(EASVIEW=1:"NEW",EASVIEW=2:"IN REVIEW",EASVIEW=3:"PRINTED, PENDING SIG.",EASVIEW=4:"SIGNED",EASVIEW=5:"FILED",EASVIEW=6:"INACTIVATED",1:"")
- S HDR=HDR_H
- S VALMHDR(2)="Application Status: "_$S(HDR="":"Unknown",1:HDR)
- S VALMHDR(3)=" "
- Q
- ;
- INIT ;Init variables and list array
- ;
- S VALMSG=$$MSG^EASEZLM
- S EASARY="EASEZ"
- K ^TMP("EASEZ",$J),^TMP($J,712),^TMP("EASEZIDX",$J)
- ;determine processing status
- ;I EASPSTAT="" S V=EASVIEW,EASPSTAT=$S(V=1:"NEW",V=2:"REV",V=3:"PRT",V=4:"SIG",V=5:"CLS",1:"") K V
- I EASPSTAT="" S V=EASVIEW,EASPSTAT=$S(V=1:"NEW",V=2:"REV",V=3:"PRT",V=4:"SIG",V=5:"FIL",V=6:"CLS",1:"") K V
- I EASPSTAT="" S VALMCNT=0 D NOLINES^EASEZLM
- I EASVIEW,EASPSTAT'="" D BLD
- ;Print message if no Applications meet selection criteria
- I 'VALMCNT D NOLINES^EASEZLM
- Q
- ;
- BLD ;Build initial EZ selection screen
- N V,JDATE,JNAME,DAT,FILDATE,WEBID,WILLSEND,VETTYPE,FAC,APP,SSN,DOB,EDATE,IT,PRT,STATION
- K ^TMP("EASEZ",$J)
- S VALMBG=1,VALMCNT=0
- S IT="" F S IT=$O(VALMDDF(IT)) Q:IT="" S X=VALMDDF(IT),EASCOL(IT)=$P(X,U,2),EASWID(IT)=$P(X,U,3)
- S EASLN=0,EASNUM=0
- I 'EASVIEW S VALMCNT=0,$P(^TMP("EASEZ",$J,0),U,4)=VALMCNT Q
- W !!,"Please wait while processing...",!!
- ;call to find all Applications needed for main LM screen
- D PICKALL^EASEZU2(EASVIEW)
- ;
- S FAC="" F S FAC=$O(^TMP($J,712,EASVIEW,FAC)) Q:FAC="" S JNAME="" F S JNAME=$O(^TMP($J,712,EASVIEW,FAC,JNAME)) Q:JNAME="" D
- .S JDATE=0 F S JDATE=$O(^TMP($J,712,EASVIEW,FAC,JNAME,JDATE)) Q:'JDATE S APP=0 F S APP=$O(^TMP($J,712,EASVIEW,FAC,JNAME,JDATE,APP)) Q:'APP D
- ..S DAT=^TMP($J,712,EASVIEW,FAC,JNAME,JDATE,APP)
- ..;reset processing status if application has filing date
- ..;I EASVIEW=4 S FILDATE=$P(DAT,U,5)
- ..S SSN=$P(DAT,U,2),VETTYPE=$P(DAT,U,3),EDATE=$P(DAT,U,4),WEBID=$P(DAT,U,6),WILLSEND=$P(DAT,U,7),FAC=$P(DAT,U,8)
- ..S PRT=$S(WILLSEND:"Vet",1:"VA")
- ..S STATION=FAC S:STATION=1 STATION=""
- ..S EASLN=EASLN+1,EASNUM=EASNUM+1
- ..S X=$$SETSTR^VALM1(EASLN,"",EASCOL("NUMBER"),EASWID("NUMBER"))
- ..S X=$$SETSTR^VALM1(JNAME,X,EASCOL("APPLICANT"),EASWID("APPLICANT"))
- ..S X=$$SETSTR^VALM1(SSN,X,EASCOL("SSN"),EASWID("SSN"))
- ..S X=$$SETSTR^VALM1(VETTYPE,X,EASCOL("TYPE"),EASWID("TYPE"))
- ..S X=$$SETSTR^VALM1(EDATE,X,EASCOL("DATE"),EASWID("DATE"))
- ..S X=$$SETSTR^VALM1(" "_PRT,X,EASCOL("PRINTED"),EASWID("PRINTED"))
- ..S X=$$SETSTR^VALM1(STATION,X,EASCOL("STATION"),EASWID("STATION"))
- ..S X=$$SETSTR^VALM1(APP,X,EASCOL("APPNUM"),EASWID("APPNUM"))
- ..S ^TMP("EASEZ",$J,EASLN,0)=X
- ..S ^TMP("EASEZ",$J,"IDX",EASLN,APP)=JNAME_U_EDATE
- ..;I EASVIEW=4,'FILDATE D
- ..;.S $P(^TMP("EASEZ",$J,"IDX",EASLN,APP),U,3)=1
- ..;.D FLDCTRL^VALM10(EASLN,"APPLICANT",IOINHI,IOINORM)
- ..;.D FLDCTRL^VALM10(EASLN,"APPNUM",IOINHI,IOINORM)
- ..S ^TMP("EASEZIDX",$J,APP)=JNAME_U_EDATE_U_WEBID_U_WILLSEND_U_STATION
- S VALMCNT=EASNUM
- S $P(^TMP("EASEZ",$J,0),U,4)=VALMCNT
- Q
- ;
- MSG() ;Custom message for list manager 'message window'
- ;
- I EASVIEW=4 Q "Applications not yet filed to the Patient database."
- Q "Select an Application to view."
- ;
- HELP ;Help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ;protocol action Exit code
- D CLEAN^VALM10
- D CLEAR^VALM1
- K ^TMP(EASARY_"SRT",$J),^TMP(EASARY_"IDX",$J)
- K EASBEG,EASEND,EASDFN,EASEZNEW,EASAPP,EASLOCK,EASLN
- Q
- ;
- SEL ;Select item in inital view to expand
- N BG,LST,Y,DIR,DTOUT,DUOUT,DIRUT
- S BG=VALMBG
- S LST=VALMLST
- S EASSEL=0,EASERR=0
- I 'BG D Q
- .W !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",!
- .S EASERR=1
- .S DIR(0)="E" D ^DIR K DIR
- S Y=+$P($P(XQORNOD(0),U,4),"=",2)
- I 'Y D
- .S DIR(0)="N^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY")_"(s)"
- .D ^DIR K DIR I $D(DIRUT) S EASERR=1,EASSEL=0
- Q:EASERR
- ;
- ;check for valid entries
- S EASSEL=Y
- I EASSEL<BG!(EASSEL>LST) D
- .W !,*7,"Selection '",EASSEL,"' is not a valid choice."
- .S EASERR=1,EASSEL=0 D PAUSE^VALM1
- ;
- Q
- ;
- NOLINES ;if array empty, inform user
- I $G(EASLOCK)=1 D Q
- .S ^TMP(EASARY,$J,1,0)=$$SETSTR^VALM1(" ","",1,60)
- .S ^TMP(EASARY,$J,"IDX",1,1)=""
- .S ^TMP(EASARY,$J,2,0)=$$SETSTR^VALM1("No Applications meet the selection criteria. ","",5,60)
- .S ^TMP(EASARY,$J,"IDX",2,2)=""
- I $G(EASLOCK)=0 D Q
- .S ^TMP(EASARY,$J,1,0)=$$SETSTR^VALM1(" ","",1,60)
- .S ^TMP(EASARY,$J,"IDX",1,1)=""
- .S ^TMP(EASARY,$J,2,0)=$$SETSTR^VALM1("Application being processed by another user.","",5,60)
- .S ^TMP(EASARY,$J,"IDX",2,2)=""
- .S ^TMP(EASARY,$J,3,0)=$$SETSTR^VALM1("Try again late.....","",5,60)
- .S ^TMP(EASARY,$J,"IDX",3,3)=""
- S ^TMP(EASARY,$J,1,0)=$$SETSTR^VALM1(" ","",1,60)
- S ^TMP(EASARY,$J,"IDX",1,1)=""
- S ^TMP(EASARY,$J,2,0)=$$SETSTR^VALM1("No Applications meet the selection criteria. ","",5,60)
- S ^TMP(EASARY,$J,"IDX",2,2)=""
- Q
- ;
- FNL ;option (list template) Exit code
- D CLEAN^VALM10
- D CLEAR^VALM1
- K ^TMP($J,712)
- K ^TMP("EASEZ",$J),^TMP("EASEZSRT",$J),^TMP("EASEZIDX",$J)
- K ^TMP("VALM STACK",$J)
- K EASVIEW,EASSEL,EASLN,EASNUM,EASARY,EASCOL,EASWID,EASAPP,EASPSTAT,EASRTR,EASERR
- Q
- ;
- NOACT(STAT,ACTION) ;action not allowed
- ;
- W !!,$C(7),ACTION_" not allowed for this "_STAT_" Application."
- S VALMBCK="R"
- D PAUSE^VALM1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZLM 5919 printed Feb 18, 2025@23:21:03 Page 2
- EASEZLM ;ALB/jap - 1010EZ List Manager Processing Screens ;10/12/00 13:07
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;;Mar 15, 2001
- +2 ;
- EN ;Main entry point for 1010EZ processing
- +1 ;Ask user to select processing status
- +2 WRITE @IOF
- +3 WRITE !!,"10-10EZ Application Processing --",!
- +4 KILL DIR,DTOUT,DUOUT,DIRUT,Y
- +5 SET DIR(0)="SMO^1:New;2:In Review;3:Printed, Pending Signature;4:Signed;5:Filed;6:Inactivated"
- +6 SET DIR("A")="Select Applications to View"
- +7 DO ^DIR
- KILL DIR
- +8 IF $DATA(DIRUT)
- KILL DIR,DTOUT,DUOUT,DIRUT,Y
- QUIT
- +9 ;
- +10 SET EASVIEW=0
- +11 ;I Y,"^1^2^3^4^5^"[(U_Y_U) S EASVIEW=Y
- +12 IF Y
- IF "^1^2^3^4^5^6^"[(U_Y_U)
- SET EASVIEW=Y
- +13 if 'EASVIEW
- QUIT
- +14 SET EASPSTAT=""
- +15 DO EN^EASEZL1
- +16 KILL EASVIEW
- GOTO EN
- +17 QUIT
- +18 ;
- HDR ;Header code
- +1 NEW H
- +2 SET VALMHDR(1)=" "
- +3 ;Processing - primary view
- +4 NEW HDR
- +5 SET HDR=""
- +6 SET H=$SELECT(EASVIEW=1:"NEW",EASVIEW=2:"IN REVIEW",EASVIEW=3:"PRINTED, PENDING SIG.",EASVIEW=4:"SIGNED",EASVIEW=5:"FILED",EASVIEW=6:"INACTIVATED",1:"")
- +7 SET HDR=HDR_H
- +8 SET VALMHDR(2)="Application Status: "_$SELECT(HDR="":"Unknown",1:HDR)
- +9 SET VALMHDR(3)=" "
- +10 QUIT
- +11 ;
- INIT ;Init variables and list array
- +1 ;
- +2 SET VALMSG=$$MSG^EASEZLM
- +3 SET EASARY="EASEZ"
- +4 KILL ^TMP("EASEZ",$JOB),^TMP($JOB,712),^TMP("EASEZIDX",$JOB)
- +5 ;determine processing status
- +6 ;I EASPSTAT="" S V=EASVIEW,EASPSTAT=$S(V=1:"NEW",V=2:"REV",V=3:"PRT",V=4:"SIG",V=5:"CLS",1:"") K V
- +7 IF EASPSTAT=""
- SET V=EASVIEW
- SET EASPSTAT=$SELECT(V=1:"NEW",V=2:"REV",V=3:"PRT",V=4:"SIG",V=5:"FIL",V=6:"CLS",1:"")
- KILL V
- +8 IF EASPSTAT=""
- SET VALMCNT=0
- DO NOLINES^EASEZLM
- +9 IF EASVIEW
- IF EASPSTAT'=""
- DO BLD
- +10 ;Print message if no Applications meet selection criteria
- +11 IF 'VALMCNT
- DO NOLINES^EASEZLM
- +12 QUIT
- +13 ;
- BLD ;Build initial EZ selection screen
- +1 NEW V,JDATE,JNAME,DAT,FILDATE,WEBID,WILLSEND,VETTYPE,FAC,APP,SSN,DOB,EDATE,IT,PRT,STATION
- +2 KILL ^TMP("EASEZ",$JOB)
- +3 SET VALMBG=1
- SET VALMCNT=0
- +4 SET IT=""
- FOR
- SET IT=$ORDER(VALMDDF(IT))
- if IT=""
- QUIT
- SET X=VALMDDF(IT)
- SET EASCOL(IT)=$PIECE(X,U,2)
- SET EASWID(IT)=$PIECE(X,U,3)
- +5 SET EASLN=0
- SET EASNUM=0
- +6 IF 'EASVIEW
- SET VALMCNT=0
- SET $PIECE(^TMP("EASEZ",$JOB,0),U,4)=VALMCNT
- QUIT
- +7 WRITE !!,"Please wait while processing...",!!
- +8 ;call to find all Applications needed for main LM screen
- +9 DO PICKALL^EASEZU2(EASVIEW)
- +10 ;
- +11 SET FAC=""
- FOR
- SET FAC=$ORDER(^TMP($JOB,712,EASVIEW,FAC))
- if FAC=""
- QUIT
- SET JNAME=""
- FOR
- SET JNAME=$ORDER(^TMP($JOB,712,EASVIEW,FAC,JNAME))
- if JNAME=""
- QUIT
- Begin DoDot:1
- +12 SET JDATE=0
- FOR
- SET JDATE=$ORDER(^TMP($JOB,712,EASVIEW,FAC,JNAME,JDATE))
- if 'JDATE
- QUIT
- SET APP=0
- FOR
- SET APP=$ORDER(^TMP($JOB,712,EASVIEW,FAC,JNAME,JDATE,APP))
- if 'APP
- QUIT
- Begin DoDot:2
- +13 SET DAT=^TMP($JOB,712,EASVIEW,FAC,JNAME,JDATE,APP)
- +14 ;reset processing status if application has filing date
- +15 ;I EASVIEW=4 S FILDATE=$P(DAT,U,5)
- +16 SET SSN=$PIECE(DAT,U,2)
- SET VETTYPE=$PIECE(DAT,U,3)
- SET EDATE=$PIECE(DAT,U,4)
- SET WEBID=$PIECE(DAT,U,6)
- SET WILLSEND=$PIECE(DAT,U,7)
- SET FAC=$PIECE(DAT,U,8)
- +17 SET PRT=$SELECT(WILLSEND:"Vet",1:"VA")
- +18 SET STATION=FAC
- if STATION=1
- SET STATION=""
- +19 SET EASLN=EASLN+1
- SET EASNUM=EASNUM+1
- +20 SET X=$$SETSTR^VALM1(EASLN,"",EASCOL("NUMBER"),EASWID("NUMBER"))
- +21 SET X=$$SETSTR^VALM1(JNAME,X,EASCOL("APPLICANT"),EASWID("APPLICANT"))
- +22 SET X=$$SETSTR^VALM1(SSN,X,EASCOL("SSN"),EASWID("SSN"))
- +23 SET X=$$SETSTR^VALM1(VETTYPE,X,EASCOL("TYPE"),EASWID("TYPE"))
- +24 SET X=$$SETSTR^VALM1(EDATE,X,EASCOL("DATE"),EASWID("DATE"))
- +25 SET X=$$SETSTR^VALM1(" "_PRT,X,EASCOL("PRINTED"),EASWID("PRINTED"))
- +26 SET X=$$SETSTR^VALM1(STATION,X,EASCOL("STATION"),EASWID("STATION"))
- +27 SET X=$$SETSTR^VALM1(APP,X,EASCOL("APPNUM"),EASWID("APPNUM"))
- +28 SET ^TMP("EASEZ",$JOB,EASLN,0)=X
- +29 SET ^TMP("EASEZ",$JOB,"IDX",EASLN,APP)=JNAME_U_EDATE
- +30 ;I EASVIEW=4,'FILDATE D
- +31 ;.S $P(^TMP("EASEZ",$J,"IDX",EASLN,APP),U,3)=1
- +32 ;.D FLDCTRL^VALM10(EASLN,"APPLICANT",IOINHI,IOINORM)
- +33 ;.D FLDCTRL^VALM10(EASLN,"APPNUM",IOINHI,IOINORM)
- +34 SET ^TMP("EASEZIDX",$JOB,APP)=JNAME_U_EDATE_U_WEBID_U_WILLSEND_U_STATION
- End DoDot:2
- End DoDot:1
- +35 SET VALMCNT=EASNUM
- +36 SET $PIECE(^TMP("EASEZ",$JOB,0),U,4)=VALMCNT
- +37 QUIT
- +38 ;
- MSG() ;Custom message for list manager 'message window'
- +1 ;
- +2 IF EASVIEW=4
- QUIT "Applications not yet filed to the Patient database."
- +3 QUIT "Select an Application to view."
- +4 ;
- HELP ;Help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ;protocol action Exit code
- +1 DO CLEAN^VALM10
- +2 DO CLEAR^VALM1
- +3 KILL ^TMP(EASARY_"SRT",$JOB),^TMP(EASARY_"IDX",$JOB)
- +4 KILL EASBEG,EASEND,EASDFN,EASEZNEW,EASAPP,EASLOCK,EASLN
- +5 QUIT
- +6 ;
- SEL ;Select item in inital view to expand
- +1 NEW BG,LST,Y,DIR,DTOUT,DUOUT,DIRUT
- +2 SET BG=VALMBG
- +3 SET LST=VALMLST
- +4 SET EASSEL=0
- SET EASERR=0
- +5 IF 'BG
- Begin DoDot:1
- +6 WRITE !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",!
- +7 SET EASERR=1
- +8 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +9 SET Y=+$PIECE($PIECE(XQORNOD(0),U,4),"=",2)
- +10 IF 'Y
- Begin DoDot:1
- +11 SET DIR(0)="N^"_BG_":"_LST
- SET DIR("A")="Select "_VALM("ENTITY")_"(s)"
- +12 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET EASERR=1
- SET EASSEL=0
- End DoDot:1
- +13 if EASERR
- QUIT
- +14 ;
- +15 ;check for valid entries
- +16 SET EASSEL=Y
- +17 IF EASSEL<BG!(EASSEL>LST)
- Begin DoDot:1
- +18 WRITE !,*7,"Selection '",EASSEL,"' is not a valid choice."
- +19 SET EASERR=1
- SET EASSEL=0
- DO PAUSE^VALM1
- End DoDot:1
- +20 ;
- +21 QUIT
- +22 ;
- NOLINES ;if array empty, inform user
- +1 IF $GET(EASLOCK)=1
- Begin DoDot:1
- +2 SET ^TMP(EASARY,$JOB,1,0)=$$SETSTR^VALM1(" ","",1,60)
- +3 SET ^TMP(EASARY,$JOB,"IDX",1,1)=""
- +4 SET ^TMP(EASARY,$JOB,2,0)=$$SETSTR^VALM1("No Applications meet the selection criteria. ","",5,60)
- +5 SET ^TMP(EASARY,$JOB,"IDX",2,2)=""
- End DoDot:1
- QUIT
- +6 IF $GET(EASLOCK)=0
- Begin DoDot:1
- +7 SET ^TMP(EASARY,$JOB,1,0)=$$SETSTR^VALM1(" ","",1,60)
- +8 SET ^TMP(EASARY,$JOB,"IDX",1,1)=""
- +9 SET ^TMP(EASARY,$JOB,2,0)=$$SETSTR^VALM1("Application being processed by another user.","",5,60)
- +10 SET ^TMP(EASARY,$JOB,"IDX",2,2)=""
- +11 SET ^TMP(EASARY,$JOB,3,0)=$$SETSTR^VALM1("Try again late.....","",5,60)
- +12 SET ^TMP(EASARY,$JOB,"IDX",3,3)=""
- End DoDot:1
- QUIT
- +13 SET ^TMP(EASARY,$JOB,1,0)=$$SETSTR^VALM1(" ","",1,60)
- +14 SET ^TMP(EASARY,$JOB,"IDX",1,1)=""
- +15 SET ^TMP(EASARY,$JOB,2,0)=$$SETSTR^VALM1("No Applications meet the selection criteria. ","",5,60)
- +16 SET ^TMP(EASARY,$JOB,"IDX",2,2)=""
- +17 QUIT
- +18 ;
- FNL ;option (list template) Exit code
- +1 DO CLEAN^VALM10
- +2 DO CLEAR^VALM1
- +3 KILL ^TMP($JOB,712)
- +4 KILL ^TMP("EASEZ",$JOB),^TMP("EASEZSRT",$JOB),^TMP("EASEZIDX",$JOB)
- +5 KILL ^TMP("VALM STACK",$JOB)
- +6 KILL EASVIEW,EASSEL,EASLN,EASNUM,EASARY,EASCOL,EASWID,EASAPP,EASPSTAT,EASRTR,EASERR
- +7 QUIT
- +8 ;
- NOACT(STAT,ACTION) ;action not allowed
- +1 ;
- +2 WRITE !!,$CHAR(7),ACTION_" not allowed for this "_STAT_" Application."
- +3 SET VALMBCK="R"
- +4 DO PAUSE^VALM1
- +5 QUIT