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

SCMCTPU4.m

Go to the documentation of this file.
  1. SCMCTPU4 ;ALB/MJK - Team Position Dangler Bulletin ; 10-JUL-1998
  1. ;;5.3;Scheduling;**148,177**;AUG 13, 1993
  1. ;
  1. BULL ; -- send bulletin (called from SCMCTPU3)
  1. N XMY,XMTEXT,XMSUB,XMDUZ,SCLCNT
  1. D INIT
  1. D TEXT
  1. IF 'SCSTOP D ^XMD
  1. D FINAL
  1. Q
  1. ;
  1. INIT ; -- set vars for bulletin
  1. N SCPCT
  1. S XMDUZ=.5
  1. S XMY($S($G(DUZ):DUZ,1:XMDUZ))=""
  1. S XMSUB="Patient Team Position Assignment Review"
  1. K ^TMP("SCTPTEXT",$J)
  1. S XMTEXT="^TMP(""SCTPTEXT"",$J,"
  1. S SCLCNT=0
  1. S SCPCT="0.00"
  1. IF $G(SCNT("TOTAL")) S SCPCT=(+$G(SCNT("BAD"))/+$G(SCNT("TOTAL")))*100
  1. ;
  1. ; -- summary info
  1. ;
  1. D SET(" In order to correct the following active positions with discharged team")
  1. D SET("assignments, please refer to the documentation for the Patient Team")
  1. D SET("Position Assignment Review option found in the Stand-alone Options")
  1. D SET("Section of the PCMM User Guide.")
  1. D SET(" ")
  1. ;
  1. ;D SET(" ")
  1. ;D SET(" Mode: "_$S(SCMODE=1:"Diagnostic Only",1:"Fix"))
  1. ;
  1. ; -- show teams
  1. D SET(" Teams Reviewed: "_$S(SCTMLST=1:"All",1:""))
  1. IF SCTMLST=0 D
  1. . ; -- sort and set
  1. . N SCTMI,X
  1. . S SCTMI=0
  1. . F S SCTMI=$O(SCTMLST(SCTMI)) Q:'SCTMI S X(SCTMLST(SCTMI)_SCTMI)=SCTMLST(SCTMI)
  1. . S SCTMI=""
  1. . F S SCTMI=$O(X(SCTMI)) Q:SCTMI="" D SET(" "_X(SCTMI))
  1. . D SET(" ")
  1. . Q
  1. ;
  1. D SET(" ")
  1. D SET(" Patient Team Position Assignments Reviewed: "_$J(+$G(SCNT("TOTAL")),6))
  1. D SET(" Number of Assignments with Problems : "_$J(+$G(SCNT("BAD")),6)_" ("_$J(SCPCT,6,2)_"%)")
  1. D SET(" ")
  1. D DASH("=")
  1. Q
  1. ;
  1. FINAL ; -- clean up
  1. K ^TMP("SCTPTEXT",$J)
  1. Q
  1. ;
  1. TEXT ; -- set of mm array
  1. N SCTMI,SCTPI,SCPTI,SCASDTI,SCPTAI
  1. ;
  1. ; -- sort is by team, position, patient, assign date, position assignment ien
  1. ;
  1. S SCSTOP=0
  1. S SCTMI=""
  1. F S SCTMI=$O(@SCERTMP@(SCTMI)) Q:SCTMI="" D Q:SCSTOP
  1. . S SCTPI="" F S SCTPI=$O(@SCERTMP@(SCTMI,SCTPI)) Q:SCTPI="" D
  1. . . S SCPTI="" F S SCPTI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI)) Q:SCPTI="" D
  1. . . . S SCASDTI=0 F S SCASDTI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI)) Q:'SCASDTI D
  1. . . . . S SCTPAI=0 F S SCTPAI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI,SCTPAI)) Q:'SCTPAI D PTA
  1. . ;
  1. . ; -- check if user asked job to stop
  1. . IF $$S^%ZTLOAD() S (SCSTOP,ZTSTOP)=1
  1. Q
  1. ;
  1. PTA ; -- process errors for team position assignment
  1. N SCTP,SCTP0,SCTPNM
  1. N SCTM,SCTM0,SCTMNM
  1. N SCPT,SCPT0,SCPTNM,SCPTID
  1. N SCTPA,SCTPA0,SCTPASDT,SCTPUNDT
  1. N SCTMA,SCTMA0,SCTMASDT,SCTMUNDT
  1. N SCER
  1. ; -- get data
  1. D DATA^SCMCTPU3(SCTPAI)
  1. ;
  1. ; -- set mm text
  1. D SET(" Team: "_SCTMNM_" Position: "_SCTPNM)
  1. D SET(" Patient: "_SCPTNM_" ("_SCPTID_")")
  1. S SCER=0
  1. F S SCER=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI,SCTPAI,SCER)) Q:'SCER D
  1. . IF SCER=1 D
  1. . . D SET(" Error: Position Assigned Date is BEFORE Team Assigned Date")
  1. . . D SET(" Position Assigned Date: "_$$FMTE^XLFDT($E(SCTPASDT,1,7),"5Z"))
  1. . . D SET(" Team Assigned Date: "_$$FMTE^XLFDT($E(SCTMASDT,1,7),"5Z"))
  1. . ;
  1. . IF SCER=2 D
  1. . . D SET(" Error: Position Unassigned Date is AFTER Team Unassigned Date")
  1. . . D SET(" Team Unassigned Date: "_$S(SCTMUNDT=9999999:"<none>",1:$$FMTE^XLFDT($E(SCTMUNDT,1,7),"5Z")))
  1. . . D SET(" Position Unassigned Date: "_$S(SCTPUNDT=9999999:"<none>",1:$$FMTE^XLFDT($E(SCTPUNDT,1,7),"5Z")))
  1. . ; -- do fix if selected
  1. . IF SCMODE=2 D FIX
  1. D DASH()
  1. Q
  1. ;
  1. FIX ; -- fix team position assignment entry (future)
  1. Q
  1. ;
  1. SET(X) ;
  1. S SCLCNT=SCLCNT+1,^TMP("SCTPTEXT",$J,SCLCNT,0)=X
  1. Q
  1. ;
  1. DASH(CHAR) ; -- send line of CHAR
  1. N X
  1. S $P(X,$E($G(CHAR,"-")),78)=""
  1. D SET(" "_X)
  1. Q
  1. ;