| [613] | 1 | SCMCTPU4 ;ALB/MJK - Team Position Dangler Bulletin ; 10-JUL-1998
|
|---|
| 2 | ;;5.3;Scheduling;**148,177**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | BULL ; -- send bulletin (called from SCMCTPU3)
|
|---|
| 5 | N XMY,XMTEXT,XMSUB,XMDUZ,SCLCNT
|
|---|
| 6 | D INIT
|
|---|
| 7 | D TEXT
|
|---|
| 8 | IF 'SCSTOP D ^XMD
|
|---|
| 9 | D FINAL
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | INIT ; -- set vars for bulletin
|
|---|
| 13 | N SCPCT
|
|---|
| 14 | S XMDUZ=.5
|
|---|
| 15 | S XMY($S($G(DUZ):DUZ,1:XMDUZ))=""
|
|---|
| 16 | S XMSUB="Patient Team Position Assignment Review"
|
|---|
| 17 | K ^TMP("SCTPTEXT",$J)
|
|---|
| 18 | S XMTEXT="^TMP(""SCTPTEXT"",$J,"
|
|---|
| 19 | S SCLCNT=0
|
|---|
| 20 | S SCPCT="0.00"
|
|---|
| 21 | IF $G(SCNT("TOTAL")) S SCPCT=(+$G(SCNT("BAD"))/+$G(SCNT("TOTAL")))*100
|
|---|
| 22 | ;
|
|---|
| 23 | ; -- summary info
|
|---|
| 24 | ;
|
|---|
| 25 | D SET(" In order to correct the following active positions with discharged team")
|
|---|
| 26 | D SET("assignments, please refer to the documentation for the Patient Team")
|
|---|
| 27 | D SET("Position Assignment Review option found in the Stand-alone Options")
|
|---|
| 28 | D SET("Section of the PCMM User Guide.")
|
|---|
| 29 | D SET(" ")
|
|---|
| 30 | ;
|
|---|
| 31 | ;D SET(" ")
|
|---|
| 32 | ;D SET(" Mode: "_$S(SCMODE=1:"Diagnostic Only",1:"Fix"))
|
|---|
| 33 | ;
|
|---|
| 34 | ; -- show teams
|
|---|
| 35 | D SET(" Teams Reviewed: "_$S(SCTMLST=1:"All",1:""))
|
|---|
| 36 | IF SCTMLST=0 D
|
|---|
| 37 | . ; -- sort and set
|
|---|
| 38 | . N SCTMI,X
|
|---|
| 39 | . S SCTMI=0
|
|---|
| 40 | . F S SCTMI=$O(SCTMLST(SCTMI)) Q:'SCTMI S X(SCTMLST(SCTMI)_SCTMI)=SCTMLST(SCTMI)
|
|---|
| 41 | . S SCTMI=""
|
|---|
| 42 | . F S SCTMI=$O(X(SCTMI)) Q:SCTMI="" D SET(" "_X(SCTMI))
|
|---|
| 43 | . D SET(" ")
|
|---|
| 44 | . Q
|
|---|
| 45 | ;
|
|---|
| 46 | D SET(" ")
|
|---|
| 47 | D SET(" Patient Team Position Assignments Reviewed: "_$J(+$G(SCNT("TOTAL")),6))
|
|---|
| 48 | D SET(" Number of Assignments with Problems : "_$J(+$G(SCNT("BAD")),6)_" ("_$J(SCPCT,6,2)_"%)")
|
|---|
| 49 | D SET(" ")
|
|---|
| 50 | D DASH("=")
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | FINAL ; -- clean up
|
|---|
| 54 | K ^TMP("SCTPTEXT",$J)
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | TEXT ; -- set of mm array
|
|---|
| 58 | N SCTMI,SCTPI,SCPTI,SCASDTI,SCPTAI
|
|---|
| 59 | ;
|
|---|
| 60 | ; -- sort is by team, position, patient, assign date, position assignment ien
|
|---|
| 61 | ;
|
|---|
| 62 | S SCSTOP=0
|
|---|
| 63 | S SCTMI=""
|
|---|
| 64 | F S SCTMI=$O(@SCERTMP@(SCTMI)) Q:SCTMI="" D Q:SCSTOP
|
|---|
| 65 | . S SCTPI="" F S SCTPI=$O(@SCERTMP@(SCTMI,SCTPI)) Q:SCTPI="" D
|
|---|
| 66 | . . S SCPTI="" F S SCPTI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI)) Q:SCPTI="" D
|
|---|
| 67 | . . . S SCASDTI=0 F S SCASDTI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI)) Q:'SCASDTI D
|
|---|
| 68 | . . . . S SCTPAI=0 F S SCTPAI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI,SCTPAI)) Q:'SCTPAI D PTA
|
|---|
| 69 | . ;
|
|---|
| 70 | . ; -- check if user asked job to stop
|
|---|
| 71 | . IF $$S^%ZTLOAD() S (SCSTOP,ZTSTOP)=1
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | PTA ; -- process errors for team position assignment
|
|---|
| 75 | N SCTP,SCTP0,SCTPNM
|
|---|
| 76 | N SCTM,SCTM0,SCTMNM
|
|---|
| 77 | N SCPT,SCPT0,SCPTNM,SCPTID
|
|---|
| 78 | N SCTPA,SCTPA0,SCTPASDT,SCTPUNDT
|
|---|
| 79 | N SCTMA,SCTMA0,SCTMASDT,SCTMUNDT
|
|---|
| 80 | N SCER
|
|---|
| 81 | ; -- get data
|
|---|
| 82 | D DATA^SCMCTPU3(SCTPAI)
|
|---|
| 83 | ;
|
|---|
| 84 | ; -- set mm text
|
|---|
| 85 | D SET(" Team: "_SCTMNM_" Position: "_SCTPNM)
|
|---|
| 86 | D SET(" Patient: "_SCPTNM_" ("_SCPTID_")")
|
|---|
| 87 | S SCER=0
|
|---|
| 88 | F S SCER=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI,SCTPAI,SCER)) Q:'SCER D
|
|---|
| 89 | . IF SCER=1 D
|
|---|
| 90 | . . D SET(" Error: Position Assigned Date is BEFORE Team Assigned Date")
|
|---|
| 91 | . . D SET(" Position Assigned Date: "_$$FMTE^XLFDT($E(SCTPASDT,1,7),"5Z"))
|
|---|
| 92 | . . D SET(" Team Assigned Date: "_$$FMTE^XLFDT($E(SCTMASDT,1,7),"5Z"))
|
|---|
| 93 | . ;
|
|---|
| 94 | . IF SCER=2 D
|
|---|
| 95 | . . D SET(" Error: Position Unassigned Date is AFTER Team Unassigned Date")
|
|---|
| 96 | . . D SET(" Team Unassigned Date: "_$S(SCTMUNDT=9999999:"<none>",1:$$FMTE^XLFDT($E(SCTMUNDT,1,7),"5Z")))
|
|---|
| 97 | . . D SET(" Position Unassigned Date: "_$S(SCTPUNDT=9999999:"<none>",1:$$FMTE^XLFDT($E(SCTPUNDT,1,7),"5Z")))
|
|---|
| 98 | . ; -- do fix if selected
|
|---|
| 99 | . IF SCMODE=2 D FIX
|
|---|
| 100 | D DASH()
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | FIX ; -- fix team position assignment entry (future)
|
|---|
| 104 | Q
|
|---|
| 105 | ;
|
|---|
| 106 | SET(X) ;
|
|---|
| 107 | S SCLCNT=SCLCNT+1,^TMP("SCTPTEXT",$J,SCLCNT,0)=X
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | DASH(CHAR) ; -- send line of CHAR
|
|---|
| 111 | N X
|
|---|
| 112 | S $P(X,$E($G(CHAR,"-")),78)=""
|
|---|
| 113 | D SET(" "_X)
|
|---|
| 114 | Q
|
|---|
| 115 | ;
|
|---|
