SCMCBK9 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1;;Aug 7, 1998
;;5.3;Scheduling;**148**;AUG 13, 1993
Q
;
MAILLST(SCTP,SCFIELDA,SCDATE,SCNEWTP,SCOLDTP,SCBADTP,SCTOTCNT) ;
; ;like MAILLIST^SCMCTPM(...
; Input:
; SCTP - Pointer to Team Position File (#404.57)
; SCFIELDA - Field array with internal values
; SCDATE - Effective Date
; SCNEWTP - DFN array of newly assigned to position
; SCOLDTP - DFN array of previously assigned to position
; SCBADTP - DFN array of patients unassignable to position
; SCTOTCNT - Count of DFN array passed to process
;
N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCTPDT,ZTQUEUED
N SCTPNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE
N SCE,SCB,SCTMNM,SCDELTEM,SCDETAIL,SCJ,SCL
;
D PREP1^SCMCBK7
;
S SCTPNM=$P($G(^SCTM(404.57,+SCTP,0)),U,1)
S XMSUB=$$S(4)_SCTPNM
S XMTEXT="^TMP($J,""SCTPXM"","
S SCTMNM=$P($G(^SCTM(404.51,+$P($G(^SCTM(404.57,+SCTP,0)),U,2),0)),U,1)
;
D SETLN($$S(5)_SCTMNM)
D SETLN($$S(6)_SCTPNM)
D SETLN($$S(7)_$$FMTE^XLFDT(SCDATE))
D SETLN($$S(8)_SCTOTCNT)
D SETLN(" ")
;
IF $D(SCFIELDA) D
.F SCNDX=1:1:14 S SCFLD=SCNDX*.01 IF $D(SCFIELDA(SCFLD)) D
..S $P(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
..D SETLN($$TEXT^SCMCTPM(404.43,SCNODE,SCNDX,SCSPACE,1))
;
I SCTOTCNT=0 G MAIL
;
NEW I $S('$D(SCNEWTP):0,1:$O(@SCNEWTP@(0))) D BLDLST(1)
;
BAD I $S('$D(SCBADTP):0,1:$O(@SCBADTP@(0))) D BLDLST(2)
;
OLD I $S('$D(SCOLDTP):0,1:$O(@SCOLDTP@(0))) D BLDLST(3)
;
MAIL D SEND^SCMCBK7(9)
;
QTMULT K:$G(SCDELTEM) ^TMP("SCTP MAIL LST",$J,SCTP)
K ^TMP($J,"SCTPXM")
Q
;
SETLN(TEXT) ;
D SETLN^SCMCTPM(TEXT)
Q
;
BLDLST(SCL) ;create text by new/bad/old
;input SCL = for header line, ^tmp, $o
N SCJ
D SETLN(" ")
D SETLN($$S(SCL))
S SCJ="^TMP(""SCTP MAIL LST"","_$J_","_SCTP_","_SCL_")"
S DFN=0
F S DFN=$$O(SCL) Q:'DFN D DTLLST^SCMCBK7
D SETLST^SCMCBK7(1)
Q
;
O(SCL) ;returns next patient in array
Q $S(SCL=1:$O(@SCNEWTP@(DFN)),SCL=2:$O(@SCBADTP@(DFN)),1:$O(@SCOLDTP@(DFN)))
;
S(SCL) ;return text string
Q $P($T(T+SCL),";;",2)
;
T ;;
;;There has been a new position assignment for the following patients:
;;There has been NO new position assignment for the following patients:
;;The following patients were already assigned to the target position:
;;Multiple PATIENT-POSITION ASSIGNMENT for ;;
;;Team: ;;
;;Position: ;;
;;Effective Date: ;;
;;Processed: ;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCBK9 2562 printed Dec 13, 2024@02:39:56 Page 2
SCMCBK9 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1;;Aug 7, 1998
+1 ;;5.3;Scheduling;**148**;AUG 13, 1993
+2 QUIT
+3 ;
MAILLST(SCTP,SCFIELDA,SCDATE,SCNEWTP,SCOLDTP,SCBADTP,SCTOTCNT) ;
+1 ; ;like MAILLIST^SCMCTPM(...
+2 ; Input:
+3 ; SCTP - Pointer to Team Position File (#404.57)
+4 ; SCFIELDA - Field array with internal values
+5 ; SCDATE - Effective Date
+6 ; SCNEWTP - DFN array of newly assigned to position
+7 ; SCOLDTP - DFN array of previously assigned to position
+8 ; SCBADTP - DFN array of patients unassignable to position
+9 ; SCTOTCNT - Count of DFN array passed to process
+10 ;
+11 NEW XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCTPDT,ZTQUEUED
+12 NEW SCTPNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE
+13 NEW SCE,SCB,SCTMNM,SCDELTEM,SCDETAIL,SCJ,SCL
+14 ;
+15 DO PREP1^SCMCBK7
+16 ;
+17 SET SCTPNM=$PIECE($GET(^SCTM(404.57,+SCTP,0)),U,1)
+18 SET XMSUB=$$S(4)_SCTPNM
+19 SET XMTEXT="^TMP($J,""SCTPXM"","
+20 SET SCTMNM=$PIECE($GET(^SCTM(404.51,+$PIECE($GET(^SCTM(404.57,+SCTP,0)),U,2),0)),U,1)
+21 ;
+22 DO SETLN($$S(5)_SCTMNM)
+23 DO SETLN($$S(6)_SCTPNM)
+24 DO SETLN($$S(7)_$$FMTE^XLFDT(SCDATE))
+25 DO SETLN($$S(8)_SCTOTCNT)
+26 DO SETLN(" ")
+27 ;
+28 IF $DATA(SCFIELDA)
Begin DoDot:1
+29 FOR SCNDX=1:1:14
SET SCFLD=SCNDX*.01
IF $DATA(SCFIELDA(SCFLD))
Begin DoDot:2
+30 SET $PIECE(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
+31 DO SETLN($$TEXT^SCMCTPM(404.43,SCNODE,SCNDX,SCSPACE,1))
End DoDot:2
End DoDot:1
+32 ;
+33 IF SCTOTCNT=0
GOTO MAIL
+34 ;
NEW IF $SELECT('$DATA(SCNEWTP):0,1:$ORDER(@SCNEWTP@(0)))
DO BLDLST(1)
+1 ;
BAD IF $SELECT('$DATA(SCBADTP):0,1:$ORDER(@SCBADTP@(0)))
DO BLDLST(2)
+1 ;
OLD IF $SELECT('$DATA(SCOLDTP):0,1:$ORDER(@SCOLDTP@(0)))
DO BLDLST(3)
+1 ;
MAIL DO SEND^SCMCBK7(9)
+1 ;
QTMULT if $GET(SCDELTEM)
KILL ^TMP("SCTP MAIL LST",$JOB,SCTP)
+1 KILL ^TMP($JOB,"SCTPXM")
+2 QUIT
+3 ;
SETLN(TEXT) ;
+1 DO SETLN^SCMCTPM(TEXT)
+2 QUIT
+3 ;
BLDLST(SCL) ;create text by new/bad/old
+1 ;input SCL = for header line, ^tmp, $o
+2 NEW SCJ
+3 DO SETLN(" ")
+4 DO SETLN($$S(SCL))
+5 SET SCJ="^TMP(""SCTP MAIL LST"","_$JOB_","_SCTP_","_SCL_")"
+6 SET DFN=0
+7 FOR
SET DFN=$$O(SCL)
if 'DFN
QUIT
DO DTLLST^SCMCBK7
+8 DO SETLST^SCMCBK7(1)
+9 QUIT
+10 ;
O(SCL) ;returns next patient in array
+1 QUIT $SELECT(SCL=1:$ORDER(@SCNEWTP@(DFN)),SCL=2:$ORDER(@SCBADTP@(DFN)),1:$ORDER(@SCOLDTP@(DFN)))
+2 ;
S(SCL) ;return text string
+1 QUIT $PIECE($TEXT(T+SCL),";;",2)
+2 ;
T ;;
+1 ;;There has been a new position assignment for the following patients:
+2 ;;There has been NO new position assignment for the following patients:
+3 ;;The following patients were already assigned to the target position:
+4 ;;Multiple PATIENT-POSITION ASSIGNMENT for ;;
+5 ;;Team: ;;
+6 ;;Position: ;;
+7 ;;Effective Date: ;;
+8 ;;Processed: ;;
+9 ;
