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 Dec 13, 2024@01:54:39 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
