| 1 | SCMCBK9 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1;;Aug 7, 1998
|
|---|
| 2 | ;;5.3;Scheduling;**148**;AUG 13, 1993
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | MAILLST(SCTP,SCFIELDA,SCDATE,SCNEWTP,SCOLDTP,SCBADTP,SCTOTCNT) ;
|
|---|
| 6 | ; ;like MAILLIST^SCMCTPM(...
|
|---|
| 7 | ; Input:
|
|---|
| 8 | ; SCTP - Pointer to Team Position File (#404.57)
|
|---|
| 9 | ; SCFIELDA - Field array with internal values
|
|---|
| 10 | ; SCDATE - Effective Date
|
|---|
| 11 | ; SCNEWTP - DFN array of newly assigned to position
|
|---|
| 12 | ; SCOLDTP - DFN array of previously assigned to position
|
|---|
| 13 | ; SCBADTP - DFN array of patients unassignable to position
|
|---|
| 14 | ; SCTOTCNT - Count of DFN array passed to process
|
|---|
| 15 | ;
|
|---|
| 16 | N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCTPDT,ZTQUEUED
|
|---|
| 17 | N SCTPNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE
|
|---|
| 18 | N SCE,SCB,SCTMNM,SCDELTEM,SCDETAIL,SCJ,SCL
|
|---|
| 19 | ;
|
|---|
| 20 | D PREP1^SCMCBK7
|
|---|
| 21 | ;
|
|---|
| 22 | S SCTPNM=$P($G(^SCTM(404.57,+SCTP,0)),U,1)
|
|---|
| 23 | S XMSUB=$$S(4)_SCTPNM
|
|---|
| 24 | S XMTEXT="^TMP($J,""SCTPXM"","
|
|---|
| 25 | S SCTMNM=$P($G(^SCTM(404.51,+$P($G(^SCTM(404.57,+SCTP,0)),U,2),0)),U,1)
|
|---|
| 26 | ;
|
|---|
| 27 | D SETLN($$S(5)_SCTMNM)
|
|---|
| 28 | D SETLN($$S(6)_SCTPNM)
|
|---|
| 29 | D SETLN($$S(7)_$$FMTE^XLFDT(SCDATE))
|
|---|
| 30 | D SETLN($$S(8)_SCTOTCNT)
|
|---|
| 31 | D SETLN(" ")
|
|---|
| 32 | ;
|
|---|
| 33 | IF $D(SCFIELDA) D
|
|---|
| 34 | .F SCNDX=1:1:14 S SCFLD=SCNDX*.01 IF $D(SCFIELDA(SCFLD)) D
|
|---|
| 35 | ..S $P(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
|
|---|
| 36 | ..D SETLN($$TEXT^SCMCTPM(404.43,SCNODE,SCNDX,SCSPACE,1))
|
|---|
| 37 | ;
|
|---|
| 38 | I SCTOTCNT=0 G MAIL
|
|---|
| 39 | ;
|
|---|
| 40 | NEW I $S('$D(SCNEWTP):0,1:$O(@SCNEWTP@(0))) D BLDLST(1)
|
|---|
| 41 | ;
|
|---|
| 42 | BAD I $S('$D(SCBADTP):0,1:$O(@SCBADTP@(0))) D BLDLST(2)
|
|---|
| 43 | ;
|
|---|
| 44 | OLD I $S('$D(SCOLDTP):0,1:$O(@SCOLDTP@(0))) D BLDLST(3)
|
|---|
| 45 | ;
|
|---|
| 46 | MAIL D SEND^SCMCBK7(9)
|
|---|
| 47 | ;
|
|---|
| 48 | QTMULT K:$G(SCDELTEM) ^TMP("SCTP MAIL LST",$J,SCTP)
|
|---|
| 49 | K ^TMP($J,"SCTPXM")
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | SETLN(TEXT) ;
|
|---|
| 53 | D SETLN^SCMCTPM(TEXT)
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | BLDLST(SCL) ;create text by new/bad/old
|
|---|
| 57 | ;input SCL = for header line, ^tmp, $o
|
|---|
| 58 | N SCJ
|
|---|
| 59 | D SETLN(" ")
|
|---|
| 60 | D SETLN($$S(SCL))
|
|---|
| 61 | S SCJ="^TMP(""SCTP MAIL LST"","_$J_","_SCTP_","_SCL_")"
|
|---|
| 62 | S DFN=0
|
|---|
| 63 | F S DFN=$$O(SCL) Q:'DFN D DTLLST^SCMCBK7
|
|---|
| 64 | D SETLST^SCMCBK7(1)
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | O(SCL) ;returns next patient in array
|
|---|
| 68 | Q $S(SCL=1:$O(@SCNEWTP@(DFN)),SCL=2:$O(@SCBADTP@(DFN)),1:$O(@SCOLDTP@(DFN)))
|
|---|
| 69 | ;
|
|---|
| 70 | S(SCL) ;return text string
|
|---|
| 71 | Q $P($T(T+SCL),";;",2)
|
|---|
| 72 | ;
|
|---|
| 73 | T ;;
|
|---|
| 74 | ;;There has been a new position assignment for the following patients:
|
|---|
| 75 | ;;There has been NO new position assignment for the following patients:
|
|---|
| 76 | ;;The following patients were already assigned to the target position:
|
|---|
| 77 | ;;Multiple PATIENT-POSITION ASSIGNMENT for ;;
|
|---|
| 78 | ;;Team: ;;
|
|---|
| 79 | ;;Position: ;;
|
|---|
| 80 | ;;Effective Date: ;;
|
|---|
| 81 | ;;Processed: ;;
|
|---|
| 82 | ;
|
|---|
