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

SCMCMU4.m

Go to the documentation of this file. 
  1. SCMCMU4 ;ALB/MJK - PCMM Mass Team/Position Unassignment Bulletin ; 10-JUL-1998
  1.  ;;5.3;Scheduling;**148,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. BULL ; -- send bulletin
  1.  N SCLCNT,XMY,XMTEXT,XMSUB,XMDUZ,SCINFO
  1.  D INIT
  1.  D TEXT
  1.  D ^XMD
  1.  D FINAL
  1.  Q
  1.  ;
  1. INIT ; -- set vars for bulletin
  1.  N SCCLN
  1.  S XMDUZ=.5
  1.  S XMY($S($G(DUZ):DUZ,1:XMDUZ))=""
  1.  S XMSUB="Mass Team"_$S(SCMUTYPE="P":"Position",1:"")_" Unassignment Information"
  1.  K ^TMP("SCMUTEXT",$J) S XMTEXT="^TMP(""SCMUTEXT"",$J,",SCLCNT=0
  1.  ;
  1.  S SCINFO("NAME","TEAM")=$P($G(^SCTM(404.51,+$G(SCTEAM),0),"Unknown"),U)
  1.  ;
  1.  IF SCMUTYPE="P" D
  1.  . S SCPOS0=$G(^SCTM(404.57,+$G(SCPOS),0),"Unknown")
  1.  . S SCINFO("NAME","POSITION")=$P(SCPOS0,U)
  1.  . S SCCLN=+$P(SCPOS0,U,9)
  1.  . IF SCCLN S SCINFO("NAME","CLINIC")=$P($G(^SC(SCCLN,0),""),U)
  1.  . Q
  1.  ;
  1.  S SCINFO("NAME","USER")=$P($G(^VA(200,XMDUZ,0),"Unknown"),U)
  1.  S SCINFO("DATE","EFFECTIVE")=$$FMTE^XLFDT($E(SCDATE,1,7),"5Z")
  1.  ;
  1.  Q
  1.  ;
  1. FINAL ; -- clean up
  1.  K ^TMP("SCMUTEXT",$J)
  1.  Q
  1.  ;
  1. TEXT ; -- set of mm array
  1.  D SET("Mass Team"_$S(SCMUTYPE="P":"-Position",1:"")_" Unassignment has been completed.")
  1.  D SET("")
  1.  D SET("             Team: "_SCINFO("NAME","TEAM"))
  1.  ;
  1.  IF SCMUTYPE="P" D
  1.  . D SET("         Position: "_SCINFO("NAME","POSITION"))
  1.  . IF $G(SCINFO("NAME","CLINIC"))]"" D SET("           Clinic: "_SCINFO("NAME","CLINIC"))
  1.  . Q
  1.  ;
  1.  D SET("             User: "_SCINFO("NAME","USER"))
  1.  D SET("   Effective Date: "_SCINFO("DATE","EFFECTIVE"))
  1.  ;
  1.  D SET("")
  1.  D SET(" Patients Processed")
  1.  D SET("   Unassigned     : "_SCUNCNT)
  1.  D SET("   Errors/Warnings: "_SCASCNT_"    (still assigned)")
  1.  D SET("   Total          : "_SCSELCNT)
  1.  ;
  1.  D CLINIC
  1.  D SET("")
  1.  ;
  1.  ; -- list pats that remain assigned
  1.  D ERRARY
  1.  ;
  1.  D SET("")
  1.  D SET("")
  1.  ;
  1.  ; -- list pats unassigned
  1.  D OKARY
  1.  Q
  1.  ;
  1. SET(X) ;
  1.  S SCLCNT=SCLCNT+1,^TMP("SCMUTEXT",$J,SCLCNT,0)=X
  1.  Q
  1.  ;
  1. ERRARY ; -- process error array
  1.  N SCNT,SCX,SCER,SCERI
  1.  ;
  1.  D SET(" Error List:")
  1.  D SET(" ===========")
  1.  ;
  1.  IF '$O(@SCBADAR@(0)) D  Q
  1.  . D SET("     No errors to report.")
  1.  . Q
  1.  ;
  1.  D HDR
  1.  ;
  1.  S SCNT=0
  1.  F  S SCNT=$O(@SCBADAR@(SCNT)) Q:'SCNT  D
  1.  . S SCX=@SCBADAR@(SCNT)
  1.  . D PT(SCNT)
  1.  . ;
  1.  . IF '$D(@SCERRAR@(SCNT)) Q
  1.  . S SCERI=0
  1.  . F  S SCERI=$O(@SCERRAR@(SCNT,"TEAM",SCTEAM,SCERI)) Q:'SCERI  D
  1.  . . S SCER=$G(@SCERRAR@(SCNT,"TEAM",SCTEAM,SCERI))
  1.  . . D SET("     >>> "_SCER)
  1.  . . Q
  1.  . ;
  1.  . IF '$O(@SCERRAR@(SCNT,"POS",0)) Q
  1.  . S SCPOS=0
  1.  . F  S SCPOS=$O(@SCERRAR@(SCNT,"POS",SCPOS)) Q:'SCPOS  D
  1.  . . IF SCMUTYPE="T" D SET("     >>> Position: "_$P($G(^SCTM(404.57,SCPOS,0),"Unknown"),U))
  1.  . . S SCERI=0
  1.  . . F  S SCERI=$O(@SCERRAR@(SCNT,"POS",SCPOS,SCERI)) Q:'SCERI  D
  1.  . . . S SCER=$G(@SCERRAR@(SCNT,"POS",SCPOS,SCERI))
  1.  . . . D SET("         >>>> "_SCER)
  1.  . . . Q
  1.  . . Q
  1.  . D SET("")
  1.  . Q
  1.  Q
  1.  ;
  1. OKARY ; -- process ok array
  1.  N SCNT,SCPT,SCX
  1.  D SET(" Unassigned List:")
  1.  D SET(" ================")
  1.  ;
  1.  IF '$O(@SCOKAR@(0)) D  Q
  1.  . D SET("     No patients unassigned.")
  1.  . Q
  1.  ;
  1.  D HDR
  1.  ;
  1.  S SCNT=0
  1.  F  S SCNT=$O(@SCOKAR@(SCNT)) Q:'SCNT  D
  1.  . D PT(SCNT)
  1.  . D TM(SCNT)
  1.  . D POS(SCNT)
  1.  . Q
  1.  Q
  1.  ;
  1. HDR ; -- send patient info header
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("Patient",X,2,7)
  1.  S X=$$SETSTR^VALM1("ID",X,40,2)
  1.  D SET(X)
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("-------",X,2,7)
  1.  S X=$$SETSTR^VALM1("--",X,40,2)
  1.  D SET(X)
  1.  Q
  1.  ;
  1. PT(SCNT) ; -- send patient info
  1.  N NAME,ID,X,SCPT,SCX
  1.  S SCPT=$G(@SCPTINFO@(SCNT))
  1.  S NAME=$P(SCPT,U,2)
  1.  S ID=$P(SCPT,U,6)
  1.  S X=""
  1.  S X=$$SETSTR^VALM1(NAME,X,2,30)
  1.  S X=$$SETSTR^VALM1(ID,X,40,15)
  1.  D SET(X)
  1.  Q
  1.  ;
  1. TM(SCNT) ; -- show any team info for patient
  1.  N SCTMMSG
  1.  S SCTMMSG=$G(@SCOKAR@(SCNT,"TEAM",SCTEAM,1))
  1.  D INFO("TEAM",SCTEAM)
  1.  Q
  1.  ;
  1. POS(SCNT) ; -- send position (for team unassignment) & clinic discharge info
  1.  N SCPOS,SCTPMSG,SCCLNM,SCPOS0,SCLNX,SCI
  1.  S SCPOS=0
  1.  F  S SCPOS=$O(@SCOKAR@(SCNT,"POS",SCPOS)) Q:'SCPOS  D
  1.  . S SCTPMSG=$G(@SCOKAR@(SCNT,"POS",SCPOS,1))
  1.  . S SCLNX=$G(@SCOKAR@(SCNT,"CLINIC",SCPOS,1))
  1.  . S SCPOS0=$G(^SCTM(404.57,SCPOS,0))
  1.  . ;
  1.  . IF SCMUTYPE="T" D
  1.  . . D SET("     >>> Position assignment to "_$P(SCPOS0,U)_$S(SCTPMSG="":" was unassigned.",1:":"))
  1.  . D INFO("POS",SCPOS)
  1.  . ;
  1.  . IF SCLNX]"",$D(SCTPDIS(SCPOS)) D
  1.  . . S SCCLNM=$P($G(^SC(+$P(SCPOS0,U,9),0),"Unkown"),U)
  1.  . . IF +SCLNX=1 D SET("          >>> Discharged from '"_SCCLNM_"' clinic")
  1.  . . IF +SCLNX=2 D
  1.  . . . D SET("              Still enrolled in '"_SCCLNM_"' clinic")
  1.  . . . D SET("              Reason: "_$P(SCLNX,U,2))
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. CLINIC ; -- display clinic to be discharged from
  1.  N SCPOS,SCX,Y
  1.  D SET(" ")
  1.  IF '$O(SCTPDIS(0)) D  G CLINICQ
  1.  . D SET(" Clinic Discharges:  None")
  1.  . Q
  1.  ;
  1.  S Y=""
  1.  S Y=$$SETSTR^VALM1("Clinic Discharges:",Y,2,20)
  1.  S Y=$$SETSTR^VALM1("Position",Y,25,25)
  1.  S Y=$$SETSTR^VALM1("Associated Clinic",Y,55,25)
  1.  D SET(Y)
  1.  S Y=""
  1.  S Y=$$SETSTR^VALM1("--------",Y,25,25)
  1.  S Y=$$SETSTR^VALM1("-----------------",Y,55,25)
  1.  D SET(Y)
  1.  ;
  1.  S SCPOS=0
  1.  F  S SCPOS=$O(SCTPDIS(SCPOS)) Q:'SCPOS  D
  1.  . S SCX=$G(^SCTM(404.57,SCPOS,0),"Unknown")
  1.  . S Y=""
  1.  . S Y=$$SETSTR^VALM1($E($P(SCX,U),1,25),Y,25,25)
  1.  . S Y=$$SETSTR^VALM1($E($P($G(^SC(+$P(SCX,U,9),0),"Unknown"),U),1,25),Y,55,25)
  1.  . D SET(Y)
  1.  . Q
  1.  ;
  1. CLINICQ Q
  1.  ;
  1. INFO(TYPE,SCIEN) ; -- load ok info text
  1.  N SCI
  1.  S SCI=0
  1.  F  S SCI=$O(@SCOKAR@(SCNT,TYPE,SCIEN,SCI)) Q:'SCI  D
  1.  . S X=$G(@SCOKAR@(SCNT,TYPE,SCIEN,SCI))
  1.  . IF X]"" D SET("     "_X)
  1.  . Q
  1.  Q
  1.  ;