Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASEZLM

EASEZLM.m

Go to the documentation of this file.
  1. EASEZLM ;ALB/jap - 1010EZ List Manager Processing Screens ;10/12/00 13:07
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;;Mar 15, 2001
  1. ;
  1. EN ;Main entry point for 1010EZ processing
  1. ;Ask user to select processing status
  1. W @IOF
  1. W !!,"10-10EZ Application Processing --",!
  1. K DIR,DTOUT,DUOUT,DIRUT,Y
  1. S DIR(0)="SMO^1:New;2:In Review;3:Printed, Pending Signature;4:Signed;5:Filed;6:Inactivated"
  1. S DIR("A")="Select Applications to View"
  1. D ^DIR K DIR
  1. I $D(DIRUT) K DIR,DTOUT,DUOUT,DIRUT,Y Q
  1. ;
  1. S EASVIEW=0
  1. ;I Y,"^1^2^3^4^5^"[(U_Y_U) S EASVIEW=Y
  1. I Y,"^1^2^3^4^5^6^"[(U_Y_U) S EASVIEW=Y
  1. Q:'EASVIEW
  1. S EASPSTAT=""
  1. D EN^EASEZL1
  1. K EASVIEW G EN
  1. Q
  1. ;
  1. HDR ;Header code
  1. N H
  1. S VALMHDR(1)=" "
  1. ;Processing - primary view
  1. N HDR
  1. S HDR=""
  1. 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:"")
  1. S HDR=HDR_H
  1. S VALMHDR(2)="Application Status: "_$S(HDR="":"Unknown",1:HDR)
  1. S VALMHDR(3)=" "
  1. Q
  1. ;
  1. INIT ;Init variables and list array
  1. ;
  1. S VALMSG=$$MSG^EASEZLM
  1. S EASARY="EASEZ"
  1. K ^TMP("EASEZ",$J),^TMP($J,712),^TMP("EASEZIDX",$J)
  1. ;determine processing status
  1. ;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
  1. 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
  1. I EASPSTAT="" S VALMCNT=0 D NOLINES^EASEZLM
  1. I EASVIEW,EASPSTAT'="" D BLD
  1. ;Print message if no Applications meet selection criteria
  1. I 'VALMCNT D NOLINES^EASEZLM
  1. Q
  1. ;
  1. BLD ;Build initial EZ selection screen
  1. N V,JDATE,JNAME,DAT,FILDATE,WEBID,WILLSEND,VETTYPE,FAC,APP,SSN,DOB,EDATE,IT,PRT,STATION
  1. K ^TMP("EASEZ",$J)
  1. S VALMBG=1,VALMCNT=0
  1. 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)
  1. S EASLN=0,EASNUM=0
  1. I 'EASVIEW S VALMCNT=0,$P(^TMP("EASEZ",$J,0),U,4)=VALMCNT Q
  1. W !!,"Please wait while processing...",!!
  1. ;call to find all Applications needed for main LM screen
  1. D PICKALL^EASEZU2(EASVIEW)
  1. ;
  1. 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
  1. .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
  1. ..S DAT=^TMP($J,712,EASVIEW,FAC,JNAME,JDATE,APP)
  1. ..;reset processing status if application has filing date
  1. ..;I EASVIEW=4 S FILDATE=$P(DAT,U,5)
  1. ..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)
  1. ..S PRT=$S(WILLSEND:"Vet",1:"VA")
  1. ..S STATION=FAC S:STATION=1 STATION=""
  1. ..S EASLN=EASLN+1,EASNUM=EASNUM+1
  1. ..S X=$$SETSTR^VALM1(EASLN,"",EASCOL("NUMBER"),EASWID("NUMBER"))
  1. ..S X=$$SETSTR^VALM1(JNAME,X,EASCOL("APPLICANT"),EASWID("APPLICANT"))
  1. ..S X=$$SETSTR^VALM1(SSN,X,EASCOL("SSN"),EASWID("SSN"))
  1. ..S X=$$SETSTR^VALM1(VETTYPE,X,EASCOL("TYPE"),EASWID("TYPE"))
  1. ..S X=$$SETSTR^VALM1(EDATE,X,EASCOL("DATE"),EASWID("DATE"))
  1. ..S X=$$SETSTR^VALM1(" "_PRT,X,EASCOL("PRINTED"),EASWID("PRINTED"))
  1. ..S X=$$SETSTR^VALM1(STATION,X,EASCOL("STATION"),EASWID("STATION"))
  1. ..S X=$$SETSTR^VALM1(APP,X,EASCOL("APPNUM"),EASWID("APPNUM"))
  1. ..S ^TMP("EASEZ",$J,EASLN,0)=X
  1. ..S ^TMP("EASEZ",$J,"IDX",EASLN,APP)=JNAME_U_EDATE
  1. ..;I EASVIEW=4,'FILDATE D
  1. ..;.S $P(^TMP("EASEZ",$J,"IDX",EASLN,APP),U,3)=1
  1. ..;.D FLDCTRL^VALM10(EASLN,"APPLICANT",IOINHI,IOINORM)
  1. ..;.D FLDCTRL^VALM10(EASLN,"APPNUM",IOINHI,IOINORM)
  1. ..S ^TMP("EASEZIDX",$J,APP)=JNAME_U_EDATE_U_WEBID_U_WILLSEND_U_STATION
  1. S VALMCNT=EASNUM
  1. S $P(^TMP("EASEZ",$J,0),U,4)=VALMCNT
  1. Q
  1. ;
  1. MSG() ;Custom message for list manager 'message window'
  1. ;
  1. I EASVIEW=4 Q "Applications not yet filed to the Patient database."
  1. Q "Select an Application to view."
  1. ;
  1. HELP ;Help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ;protocol action Exit code
  1. D CLEAN^VALM10
  1. D CLEAR^VALM1
  1. K ^TMP(EASARY_"SRT",$J),^TMP(EASARY_"IDX",$J)
  1. K EASBEG,EASEND,EASDFN,EASEZNEW,EASAPP,EASLOCK,EASLN
  1. Q
  1. ;
  1. SEL ;Select item in inital view to expand
  1. N BG,LST,Y,DIR,DTOUT,DUOUT,DIRUT
  1. S BG=VALMBG
  1. S LST=VALMLST
  1. S EASSEL=0,EASERR=0
  1. I 'BG D Q
  1. .W !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",!
  1. .S EASERR=1
  1. .S DIR(0)="E" D ^DIR K DIR
  1. S Y=+$P($P(XQORNOD(0),U,4),"=",2)
  1. I 'Y D
  1. .S DIR(0)="N^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY")_"(s)"
  1. .D ^DIR K DIR I $D(DIRUT) S EASERR=1,EASSEL=0
  1. Q:EASERR
  1. ;
  1. ;check for valid entries
  1. S EASSEL=Y
  1. I EASSEL<BG!(EASSEL>LST) D
  1. .W !,*7,"Selection '",EASSEL,"' is not a valid choice."
  1. .S EASERR=1,EASSEL=0 D PAUSE^VALM1
  1. ;
  1. Q
  1. ;
  1. NOLINES ;if array empty, inform user
  1. I $G(EASLOCK)=1 D Q
  1. .S ^TMP(EASARY,$J,1,0)=$$SETSTR^VALM1(" ","",1,60)
  1. .S ^TMP(EASARY,$J,"IDX",1,1)=""
  1. .S ^TMP(EASARY,$J,2,0)=$$SETSTR^VALM1("No Applications meet the selection criteria. ","",5,60)
  1. .S ^TMP(EASARY,$J,"IDX",2,2)=""
  1. I $G(EASLOCK)=0 D Q
  1. .S ^TMP(EASARY,$J,1,0)=$$SETSTR^VALM1(" ","",1,60)
  1. .S ^TMP(EASARY,$J,"IDX",1,1)=""
  1. .S ^TMP(EASARY,$J,2,0)=$$SETSTR^VALM1("Application being processed by another user.","",5,60)
  1. .S ^TMP(EASARY,$J,"IDX",2,2)=""
  1. .S ^TMP(EASARY,$J,3,0)=$$SETSTR^VALM1("Try again late.....","",5,60)
  1. .S ^TMP(EASARY,$J,"IDX",3,3)=""
  1. S ^TMP(EASARY,$J,1,0)=$$SETSTR^VALM1(" ","",1,60)
  1. S ^TMP(EASARY,$J,"IDX",1,1)=""
  1. S ^TMP(EASARY,$J,2,0)=$$SETSTR^VALM1("No Applications meet the selection criteria. ","",5,60)
  1. S ^TMP(EASARY,$J,"IDX",2,2)=""
  1. Q
  1. ;
  1. FNL ;option (list template) Exit code
  1. D CLEAN^VALM10
  1. D CLEAR^VALM1
  1. K ^TMP($J,712)
  1. K ^TMP("EASEZ",$J),^TMP("EASEZSRT",$J),^TMP("EASEZIDX",$J)
  1. K ^TMP("VALM STACK",$J)
  1. K EASVIEW,EASSEL,EASLN,EASNUM,EASARY,EASCOL,EASWID,EASAPP,EASPSTAT,EASRTR,EASERR
  1. Q
  1. ;
  1. NOACT(STAT,ACTION) ;action not allowed
  1. ;
  1. W !!,$C(7),ACTION_" not allowed for this "_STAT_" Application."
  1. S VALMBCK="R"
  1. D PAUSE^VALM1
  1. Q