| 1 | SCMCBK4 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1; AUG 5, 1998
|
|---|
| 2 | ;;5.3;Scheduling;**148,157**;AUG 13, 1993
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | QUEUED(SCX) ;if XWBAPVER=1
|
|---|
| 7 | ; ;SCX=1: called from ptfile^scmcbk
|
|---|
| 8 | ; ;SCX=2: called from posfile^scmcbk
|
|---|
| 9 | ;
|
|---|
| 10 | S SCOK("Result")=0
|
|---|
| 11 | S SC("DUZ")=DUZ
|
|---|
| 12 | S ZTDTH=$H
|
|---|
| 13 | S SCX=$$S(SCX)
|
|---|
| 14 | S ZTRTN=$P(SCX,"::")
|
|---|
| 15 | S ZTDESC=$P(SCX,"::",2)
|
|---|
| 16 | S ZTSAVE("SC(")=""
|
|---|
| 17 | ;;;S ZTSAVE("^TMP("_SC("JOB")_",")=""
|
|---|
| 18 | S ZTSAVE("^TMP($J,")=""
|
|---|
| 19 | D ^%ZTLOAD
|
|---|
| 20 | I $D(ZTSK) S SCOK("Result")=1
|
|---|
| 21 | D EXIT1^SCRPTM
|
|---|
| 22 | ;;;K SCX,^TMP(SC("JOB"))
|
|---|
| 23 | K SCX,^TMP($J)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | QMPTTM ; process patient team assignments
|
|---|
| 27 | N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR
|
|---|
| 28 | ;
|
|---|
| 29 | D SETUP
|
|---|
| 30 | ;
|
|---|
| 31 | S SCADDFLD(.08)=$G(SC("TYPE"),99)
|
|---|
| 32 | S SCADDFLD(.1)=$G(SC("RESTRICT"),0)
|
|---|
| 33 | S SCADDFLD(.11)=$G(SC("DUZ"),.5)
|
|---|
| 34 | S SCADDFLD(.12)=DT
|
|---|
| 35 | ;
|
|---|
| 36 | ; ;like $$ACPTATM^SCAPMC6(...
|
|---|
| 37 | ;;;S SCX=$$ACPTATM^SCMCBK5("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
|
|---|
| 38 | S SCX=$$ACPTATM^SCMCBK5("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
|
|---|
| 39 | ;
|
|---|
| 40 | D CLEANUP
|
|---|
| 41 | FILEQ Q
|
|---|
| 42 | ;
|
|---|
| 43 | ;
|
|---|
| 44 | QMPTPO ;process patient position assignments
|
|---|
| 45 | N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG
|
|---|
| 46 | N SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1
|
|---|
| 47 | ;
|
|---|
| 48 | D SETUP
|
|---|
| 49 | S SCADTM=1
|
|---|
| 50 | ;
|
|---|
| 51 | S SCADDFLD(.05)=$G(SC("TYPE"),0)
|
|---|
| 52 | S SCADDFLD(.06)=$G(SC("DUZ"),.5)
|
|---|
| 53 | S SCADDFLD(.07)=DT
|
|---|
| 54 | ;
|
|---|
| 55 | ; ;like $$ACPTATP^SCAPMC21(...
|
|---|
| 56 | ;;;S SCX=$$ACPTATP^SCMCBK8("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
|
|---|
| 57 | S SCX=$$ACPTATP^SCMCBK8("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
|
|---|
| 58 | ;
|
|---|
| 59 | D CLEANUP
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | SETUP D CHK^SCUTBK
|
|---|
| 63 | D TMP^SCUTBK
|
|---|
| 64 | D PARSE^SCMCBK1(.SC)
|
|---|
| 65 | S SCMAIL1=$G(SC("DUZ"),.5)
|
|---|
| 66 | S SCJOB=$J
|
|---|
| 67 | ;;;G:+$G(SCJOB)=0 FILEQ
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | CLEANUP ;;;K ^TMP(SCJOB,"SC PATIENT LIST")
|
|---|
| 71 | K ^TMP($J,"SC PATIENT LIST")
|
|---|
| 72 | D CLRVAR^SCMCBK1
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | S(SCX) ;return text string
|
|---|
| 76 | Q $P($T(T+SCX),";;",2)
|
|---|
| 77 | ;
|
|---|
| 78 | T ;;
|
|---|
| 79 | ;;QMPTTM^SCMCBK4::PCMM Multiple Patient Team Assignment
|
|---|
| 80 | ;;QMPTPO^SCMCBK4::PCMM Multiple Patient Position Assignment
|
|---|
| 81 | ;
|
|---|
