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

SCMCMU1.m

Go to the documentation of this file.
  1. SCMCMU1 ;ALB/MJK - PCMM Mass Team/Position List Manager ; 10-JUL-1998
  1. ;;5.3;Scheduling;**148**;AUG 13, 1993
  1. ;
  1. EN(SCTEAM,SCPOS,SCTPDIS,SCMUTYPE,SCDATE) ; -- main entry point for SCMC MU MASS TEAM UNASSIGNMENT
  1. D EN^VALM("SCMC MU MASS TEAM UNASSIGNMENT")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N X,SCTEAM0
  1. S SCTEAM0=$G(^SCTM(404.51,+SCTEAM,0),"Unknown")
  1. S X=$E(" Team: "_$P(SCTEAM0,U),1,40)
  1. S X=$$SETSTR^VALM1(" Total: "_+$G(SCALLCNT)_" Selected: "_+$G(SCSELCNT),X,45,35)
  1. S VALMHDR(1)=X
  1. ;
  1. S X=""
  1. IF SCMUTYPE="P" D
  1. . S SCPOS0=$G(^SCTM(404.57,+SCPOS,0),"Unknown")
  1. . S X=$E("Position: "_$P(SCPOS0,U),1,40)
  1. . IF '$G(SCTPDIS(+SCPOS)) Q
  1. . S X=$$SETSTR^VALM1("Clinic: "_$P($G(^SC(+$P(SCPOS0,U,9),0),"Unknown"),U),X,45,35)
  1. .Q
  1. ;
  1. S VALMHDR(2)=X
  1. S X="Proposed Effective Date: "_$$FMTE^XLFDT($E(SCDATE,1,7),"5Z")
  1. S X=$$SETSTR^VALM1(" View: "_SCVIEW_$S(SCVIEW="ALL":"",1:"ED"),X,45,35)
  1. S VALMHDR(3)=X
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. N SCPATS,SCI,SCALPHA,SCX,SCDTE
  1. S SCPATS=$NA(^TMP("SCMU",$J,"PATIENTS"))
  1. S SCALPHA=$NA(^TMP("SCMU",$J,"PATS ALPHA"))
  1. K @SCPATS,@SCALPHA
  1. ;
  1. ; -- set up persistent structures
  1. S SCPTINFO=$NA(^TMP("SCMU",$J,"PATIENT INFO")) ; useful patient data
  1. S SCPTSEL=$NA(^TMP("SCMU",$J,"SELECTED")) ; patients selected
  1. S SCPTALL=$NA(^TMP("SCMU",$J,"PATIENT ALL")) ; listman data
  1. ;
  1. K @SCPTINFO,@SCPTSEL,@SCPTALL
  1. S (SCALLCNT,SCSELCNT,SCMSG)=0
  1. S SCVIEW="ALL"
  1. ;
  1. W ! D WAIT^DICD
  1. ;
  1. ; -- change title is appropriate
  1. IF SCMUTYPE="P" S VALM("TITLE")="Mass Position Unassignment"
  1. ;
  1. ; -- get patients
  1. D DATE(SCDATE,.SCDTE)
  1. IF SCMUTYPE="T",'$$PTTM^SCAPMC(SCTEAM,SCDTE,SCPATS) G INITQ
  1. IF SCMUTYPE="P",'$$PTTP^SCAPMC(SCPOS,SCDTE,SCPATS) G INITQ
  1. ;
  1. ; -- build list for display
  1. S SCI=0
  1. F S SCI=$O(@SCPATS@(SCI)) Q:'SCI D
  1. . S SCX=@SCPATS@(SCI)
  1. . S @SCALPHA@($P(SCX,U,2)_SCI)=SCI
  1. . Q
  1. ;
  1. S SCNT=0
  1. S SCI=""
  1. F S SCI=$O(@SCALPHA@(SCI)) Q:SCI="" D
  1. . S SCX=$G(@SCPATS@(+@SCALPHA@(SCI)))
  1. . IF '$$FILTER(SCX,SCDATE) Q
  1. . S SCNT=SCNT+1
  1. . S Y=$$SETSTR^VALM1(SCNT,"",1,4) ; number
  1. . S Y=$$SETSTR^VALM1($P(SCX,U,2),Y,15,25) ; pt name
  1. . S Y=$$SETSTR^VALM1($P(SCX,U,6),Y,42,12) ; pt id
  1. . S Y=$$SETSTR^VALM1($$FMTE^XLFDT($P(SCX,U,4),"5Z"),Y,56,10) ; assigned
  1. . S Y=$$SETSTR^VALM1($$FMTE^XLFDT($P(SCX,U,5),"5Z"),Y,69,10) ; unassigned
  1. . ;
  1. . ; -- flag if this is a future assignment
  1. . IF $P(SCX,U,4)>DT D
  1. . . S Y=$$SETSTR^VALM1("*",Y,55,1)
  1. . . IF 'SCMSG S SCMSG=1 D MSG
  1. . ;
  1. . ; -- flag if this is a future unassignment
  1. . IF $P(SCX,U,5)>DT D
  1. . . S Y=$$SETSTR^VALM1("*",Y,68,1)
  1. . . IF 'SCMSG S SCMSG=1 D MSG
  1. . ;
  1. . S @SCPTALL@(SCNT,0)=Y
  1. . S @SCPTALL@("IDX",SCNT,SCNT)=SCNT
  1. . S @SCPTINFO@(SCNT)=SCX
  1. . Q
  1. K @SCPATS,@SCALPHA
  1. S SCALLCNT=SCNT
  1. ;
  1. ; -- set up lm array
  1. D BLD
  1. ;
  1. INITQ Q
  1. ;
  1. FILTER(SCX,SCDATE) ; -- apply filter criteria
  1. N SCOK
  1. S SCOK=1
  1. ; -- if inactivation date is =< effective then don't use
  1. IF $P(SCX,U,5),$P(SCX,U,5)'>SCDATE S SCOK=0
  1. Q SCOK
  1. ;
  1. BLD ; -- build VALMAR
  1. K @VALMAR
  1. ;
  1. IF SCVIEW="ALL" D
  1. . M @VALMAR=@SCPTALL
  1. . S VALMCNT=SCALLCNT
  1. . Q
  1. ;
  1. ELSE D
  1. . N SCNT
  1. . S (SCNT,VALMCNT)=0
  1. . F S SCNT=$O(@SCPTALL@(SCNT)) Q:'SCNT D
  1. . . ; -- if in select view and patient not selected then don't use
  1. . . IF SCVIEW="SELECT",'$D(@SCPTSEL@(SCNT)) Q
  1. . . ; -- if in de-select view and patient selected then don't use
  1. . . IF SCVIEW="DE-SELECT",$D(@SCPTSEL@(SCNT)) Q
  1. . . ;
  1. . . S VALMCNT=VALMCNT+1
  1. . . S Y=@SCPTALL@(SCNT,0)
  1. . . S @VALMAR@(VALMCNT,0)=$$SETSTR^VALM1(VALMCNT,Y,1,4)
  1. . . ;
  1. . . ; -- set idx to pointer back to SCPTALL (this is key!)
  1. . . S @VALMAR@("IDX",VALMCNT,VALMCNT)=SCNT
  1. . . Q
  1. . Q
  1. ;
  1. IF '$O(@VALMAR@(0)) D
  1. . S @VALMAR@(1,0)=" "
  1. . S @VALMAR@(2,0)=" "
  1. . S @VALMAR@(3,0)=" No patients to list."
  1. . Q
  1. IF $G(VALMBG),'$D(@VALMAR@(VALMBG,0)) S VALMBG=1
  1. K VALMHDR
  1. D BACK("R")
  1. Q
  1. ;
  1. SETSEL(FLAG,SCNT) ; -- set selected flag indicator
  1. N Y,SCPTCNT
  1. ;
  1. ; -- get pointer back to SCPTALL
  1. S SCPTCNT=+$G(@VALMAR@("IDX",SCNT,SCNT))
  1. IF FLAG="DE-SELECT",$D(@SCPTSEL@(SCPTCNT)) D
  1. . K @SCPTSEL@(SCPTCNT)
  1. . S SCSELCNT=$S(SCSELCNT=0:0,1:SCSELCNT-1)
  1. ;
  1. IF FLAG="SELECT",'$D(@SCPTSEL@(SCPTCNT)) D
  1. . S @SCPTSEL@(SCPTCNT)=""
  1. . S SCSELCNT=$S(SCSELCNT=SCALLCNT:SCALLCNT,1:SCSELCNT+1)
  1. ;
  1. S Y=$G(@VALMAR@(SCNT,0))
  1. S Y=$$SETSTR^VALM1($S(FLAG="SELECT":"Yes",1:""),Y,8,3)
  1. S @VALMAR@(SCNT,0)=Y
  1. ;
  1. ; -- need to do SCPTALL separately because of potential for differnt #'s
  1. S Y=$G(@SCPTALL@(SCPTCNT,0))
  1. S Y=$$SETSTR^VALM1($S(FLAG="SELECT":"Yes",1:""),Y,8,3)
  1. S @SCPTALL@(SCPTCNT,0)=Y
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D CLEAR^VALM1
  1. K @VALMAR,SCSELCNT,SCVIEW,SCALLCNT,SCMSG
  1. K @SCPTALL,@SCPTSEL,@SCPTINFO
  1. K SCPTALL,SCPTSEL,SCPTINFO
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. ALL(SCACT) ; -- entry point for SCMC SELECT ALL & SCMC DESELECT ALL protocols
  1. IF SCVIEW=SCACT D Q
  1. . W !!,"All patients in current view are already '"_SCACT_"ED'."
  1. . D PAUSE
  1. . D BACK("")
  1. . Q
  1. D ACT(SCACT,SCPTALL)
  1. Q
  1. ;
  1. SOME(SCACT) ; -- entry point for SCMC SELECT SOME & SCMC DESELECT SOME protocols
  1. IF SCVIEW=SCACT D Q
  1. . W !!,"All patients in current view are already '"_SCACT_"ED'."
  1. . D PAUSE
  1. . D BACK("")
  1. . Q
  1. D EN^VALM2(XQORNOD(0),"O")
  1. D ACT(SCACT,"VALMY")
  1. Q
  1. ;
  1. ACT(SCACT,SCLIST) ; -- change select flag
  1. N SCNT
  1. S SCNT=0
  1. F S SCNT=$O(@SCLIST@(SCNT)) Q:'SCNT D SETSEL(SCACT,SCNT)
  1. W !
  1. D WAIT^DICD,BLD
  1. Q
  1. ;
  1. VIEW(SCVW) ; -- change view
  1. S SCVIEW=SCVW
  1. W !
  1. D WAIT^DICD,BLD
  1. Q
  1. ;
  1. BACK(ACTION) ; -- return to lm processing
  1. IF $G(SCMSG) D MSG
  1. S VALMBCK=ACTION
  1. Q
  1. ;
  1. MSG ; -- set message var
  1. S VALMSG="* Future date"
  1. Q
  1. ;
  1. DATE(SCDATE,SCDTE) ; -- setup date array
  1. S SCDTE="SCDTE"
  1. S SCDTE("BEGIN")=SCDATE
  1. S SCDTE("END")=9999999
  1. S SCDTE("INCL")=0
  1. Q
  1. ;
  1. PAUSE ; -- pause
  1. N DIR,Y
  1. S DIR(0)="EA"
  1. S DIR("A")="Enter RETURN to continue:"
  1. D ^DIR
  1. Q