source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCBK4.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SCMCBK4 ;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 ;
6QUEUED(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 ;
26QMPTTM ; 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
41FILEQ Q
42 ;
43 ;
44QMPTPO ;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 ;
62SETUP 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 ;
70CLEANUP ;;;K ^TMP(SCJOB,"SC PATIENT LIST")
71 K ^TMP($J,"SC PATIENT LIST")
72 D CLRVAR^SCMCBK1
73 Q
74 ;
75S(SCX) ;return text string
76 Q $P($T(T+SCX),";;",2)
77 ;
78T ;;
79 ;;QMPTTM^SCMCBK4::PCMM Multiple Patient Team Assignment
80 ;;QMPTPO^SCMCBK4::PCMM Multiple Patient Position Assignment
81 ;
Note: See TracBrowser for help on using the repository browser.