SCMCBK4 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1; AUG 5, 1998
;;5.3;Scheduling;**148,157**;AUG 13, 1993
Q
;
;
QUEUED(SCX) ;if XWBAPVER=1
; ;SCX=1: called from ptfile^scmcbk
; ;SCX=2: called from posfile^scmcbk
;
S SCOK("Result")=0
S SC("DUZ")=DUZ
S ZTDTH=$H
S SCX=$$S(SCX)
S ZTRTN=$P(SCX,"::")
S ZTDESC=$P(SCX,"::",2)
S ZTSAVE("SC(")=""
;;;S ZTSAVE("^TMP("_SC("JOB")_",")=""
S ZTSAVE("^TMP($J,")=""
D ^%ZTLOAD
I $D(ZTSK) S SCOK("Result")=1
D EXIT1^SCRPTM
;;;K SCX,^TMP(SC("JOB"))
K SCX,^TMP($J)
Q
;
QMPTTM ; process patient team assignments
N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR
;
D SETUP
;
S SCADDFLD(.08)=$G(SC("TYPE"),99)
S SCADDFLD(.1)=$G(SC("RESTRICT"),0)
S SCADDFLD(.11)=$G(SC("DUZ"),.5)
S SCADDFLD(.12)=DT
;
; ;like $$ACPTATM^SCAPMC6(...
;;;S SCX=$$ACPTATM^SCMCBK5("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
S SCX=$$ACPTATM^SCMCBK5("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
;
D CLEANUP
FILEQ Q
;
;
QMPTPO ;process patient position assignments
N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG
N SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1
;
D SETUP
S SCADTM=1
;
S SCADDFLD(.05)=$G(SC("TYPE"),0)
S SCADDFLD(.06)=$G(SC("DUZ"),.5)
S SCADDFLD(.07)=DT
;
; ;like $$ACPTATP^SCAPMC21(...
;;;S SCX=$$ACPTATP^SCMCBK8("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
S SCX=$$ACPTATP^SCMCBK8("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
;
D CLEANUP
Q
;
SETUP D CHK^SCUTBK
D TMP^SCUTBK
D PARSE^SCMCBK1(.SC)
S SCMAIL1=$G(SC("DUZ"),.5)
S SCJOB=$J
;;;G:+$G(SCJOB)=0 FILEQ
Q
;
CLEANUP ;;;K ^TMP(SCJOB,"SC PATIENT LIST")
K ^TMP($J,"SC PATIENT LIST")
D CLRVAR^SCMCBK1
Q
;
S(SCX) ;return text string
Q $P($T(T+SCX),";;",2)
;
T ;;
;;QMPTTM^SCMCBK4::PCMM Multiple Patient Team Assignment
;;QMPTPO^SCMCBK4::PCMM Multiple Patient Position Assignment
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCBK4 2203 printed Sep 23, 2025@20:16:13 Page 2
SCMCBK4 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1; AUG 5, 1998
+1 ;;5.3;Scheduling;**148,157**;AUG 13, 1993
+2 QUIT
+3 ;
+4 ;
QUEUED(SCX) ;if XWBAPVER=1
+1 ; ;SCX=1: called from ptfile^scmcbk
+2 ; ;SCX=2: called from posfile^scmcbk
+3 ;
+4 SET SCOK("Result")=0
+5 SET SC("DUZ")=DUZ
+6 SET ZTDTH=$HOROLOG
+7 SET SCX=$$S(SCX)
+8 SET ZTRTN=$PIECE(SCX,"::")
+9 SET ZTDESC=$PIECE(SCX,"::",2)
+10 SET ZTSAVE("SC(")=""
+11 ;;;S ZTSAVE("^TMP("_SC("JOB")_",")=""
+12 SET ZTSAVE("^TMP($J,")=""
+13 DO ^%ZTLOAD
+14 IF $DATA(ZTSK)
SET SCOK("Result")=1
+15 DO EXIT1^SCRPTM
+16 ;;;K SCX,^TMP(SC("JOB"))
+17 KILL SCX,^TMP($JOB)
+18 QUIT
+19 ;
QMPTTM ; process patient team assignments
+1 NEW SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR
+2 ;
+3 DO SETUP
+4 ;
+5 SET SCADDFLD(.08)=$GET(SC("TYPE"),99)
+6 SET SCADDFLD(.1)=$GET(SC("RESTRICT"),0)
+7 SET SCADDFLD(.11)=$GET(SC("DUZ"),.5)
+8 SET SCADDFLD(.12)=DT
+9 ;
+10 ; ;like $$ACPTATM^SCAPMC6(...
+11 ;;;S SCX=$$ACPTATM^SCMCBK5("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
+12 SET SCX=$$ACPTATM^SCMCBK5("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
+13 ;
+14 DO CLEANUP
FILEQ QUIT
+1 ;
+2 ;
QMPTPO ;process patient position assignments
+1 NEW SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG
+2 NEW SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1
+3 ;
+4 DO SETUP
+5 SET SCADTM=1
+6 ;
+7 SET SCADDFLD(.05)=$GET(SC("TYPE"),0)
+8 SET SCADDFLD(.06)=$GET(SC("DUZ"),.5)
+9 SET SCADDFLD(.07)=DT
+10 ;
+11 ; ;like $$ACPTATP^SCAPMC21(...
+12 ;;;S SCX=$$ACPTATP^SCMCBK8("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
+13 SET SCX=$$ACPTATP^SCMCBK8("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
+14 ;
+15 DO CLEANUP
+16 QUIT
+17 ;
SETUP DO CHK^SCUTBK
+1 DO TMP^SCUTBK
+2 DO PARSE^SCMCBK1(.SC)
+3 SET SCMAIL1=$GET(SC("DUZ"),.5)
+4 SET SCJOB=$JOB
+5 ;;;G:+$G(SCJOB)=0 FILEQ
+6 QUIT
+7 ;
CLEANUP ;;;K ^TMP(SCJOB,"SC PATIENT LIST")
+1 KILL ^TMP($JOB,"SC PATIENT LIST")
+2 DO CLRVAR^SCMCBK1
+3 QUIT
+4 ;
S(SCX) ;return text string
+1 QUIT $PIECE($TEXT(T+SCX),";;",2)
+2 ;
T ;;
+1 ;;QMPTTM^SCMCBK4::PCMM Multiple Patient Team Assignment
+2 ;;QMPTPO^SCMCBK4::PCMM Multiple Patient Position Assignment
+3 ;
