200 lines
5.5 KiB
Mathematica
200 lines
5.5 KiB
Mathematica
SCMCCV3 ;bp/cmf - 195 Test/177 File - 404.57 preceptors to 404.53 ; Sep 1999
|
|
;;5.3;Scheduling;**195,177**;AUG 13, 1993
|
|
;
|
|
Q
|
|
;
|
|
ENXPD D EN(1) Q
|
|
;
|
|
ENPRE D EN(0) Q
|
|
;
|
|
EN(SCF) ;input = 1: Postinit(file)
|
|
; = 0: PrePatch(validate)
|
|
;
|
|
N SCY,SCI,SCTM,SCTP,SCREASON,SCZSTOP
|
|
K ^TMP("SCMC",$J)
|
|
S SCI=1
|
|
D BLDI("")
|
|
D BLDI($S(SCF:$$S(1),1:$$S(3)))
|
|
D BLDI($$DTU())
|
|
D BLDI($S(SCF:$$S(2),1:$$S(4)))
|
|
D BLDI("")
|
|
I SCF D I 'SCREASON D BLD($$S(16)) G MAIL
|
|
. S SCREASON=+$$FIND1^DIC(403.44,"","X","ACTIVATE PRECEPTOR LINK")
|
|
. Q
|
|
;
|
|
LOOP S SCZSTOP=0
|
|
S SCTMNM=""
|
|
F S SCTMNM=$O(^SCTM(404.51,"B",SCTMNM)) Q:(SCTMNM="")!(SCZSTOP) D
|
|
. S SCZSTOP=$S($$S^%ZTLOAD:1,1:0)
|
|
. Q:SCZSTOP
|
|
. S SCTM=$O(^SCTM(404.51,"B",SCTMNM,0))
|
|
. Q:'+$$ACTTM^SCMCTMU(SCTM) ;team inactive
|
|
. Q:'$D(^SCTM(404.57,"C",SCTM)) ;no team positions
|
|
. S SCTM(0)=1
|
|
. S SCTP=0 ;team position ien
|
|
. F S SCTP=$O(^SCTM(404.57,"C",SCTM,SCTP)) Q:('SCTP)!(SCZSTOP) D
|
|
. . S SCZSTOP=$S($$S^%ZTLOAD:1,1:0)
|
|
. . Q:SCZSTOP
|
|
. . S SCTP0=^SCTM(404.57,SCTP,0) ;team position node
|
|
. . Q:'+$P(SCTP0,U,10) ;no preceptor entry
|
|
. . S SCTPNM=$P(SCTP0,U)
|
|
. . S SCTP(0)=1
|
|
. . Q:$$AS(SCTP,SCTPNM,25) ;already seeded
|
|
. . Q:'+$$ACTTP(SCTP) ;not active
|
|
. . S SCTPFLAG=0
|
|
. . D SCII
|
|
. . I +$P(SCTP0,U,12) D SCY(6,SCTPNM,8) Q:$$SCF()
|
|
. . S SCTPP=+$P(SCTP0,U,10) ;preceptor team position ien
|
|
. . I SCTPP=SCTP D SCY(6,SCTPNM,9) Q:$$SCF()
|
|
. . I '+$$GETPRTP(SCTP) D SCY(6,SCTPNM,15) Q:$$SCF()
|
|
. . S SCTPP0=^SCTM(404.57,SCTPP,0) ;preceptor team position node
|
|
. . S SCTPPNM=$P(SCTPP0,U)
|
|
. . I (+$P(SCTP0,U,4))&('+$P(SCTPP0,U,4)) D SCY(7,SCTPPNM,10) Q:$$SCF()
|
|
. . I $P(SCTP0,U,2)'=$P(SCTPP0,U,2) D SCY(7,SCTPPNM,11) Q:$$SCF()
|
|
. . I '+$$ACTTP(SCTPP) D SCY(7,SCTPPNM,12) Q:$$SCF()
|
|
. . I +$P(SCTPP0,U,10) D SCY(7,SCTPPNM,13) Q:$$SCF()
|
|
. . Q:$$AS(SCTPP,SCTPPNM,13)
|
|
. . I '+$P(SCTPP0,U,12) D SCY(7,SCTPPNM,14) Q:$$SCF()
|
|
. . I '+$$GETPRTP(SCTPP) D SCY(7,SCTPPNM,15) Q:$$SCF()
|
|
. . I 'SCF D Q
|
|
. . . I 'SCTPFLAG D SCY(6,$$LINK(),17)
|
|
. . . Q
|
|
. . K SCFDA,SCERR
|
|
. . S SCFDA(1,404.53,"+1,",.01)=SCTP
|
|
. . S SCFDA(1,404.53,"+1,",.02)=DT
|
|
. . S SCFDA(1,404.53,"+1,",.04)=1
|
|
. . S SCFDA(1,404.53,"+1,",.05)=SCREASON
|
|
. . S SCFDA(1,404.53,"+1,",.06)=SCTPP
|
|
. . D UPDATE^DIE("","SCFDA(1)","","SCERR")
|
|
. . I $D(SCERR) D SCY(7,$$LINK(),18)
|
|
. . E D SCY(7,$$LINK(),19)
|
|
. . Q
|
|
. Q
|
|
I SCZSTOP D BLDI(0),BLD(26)
|
|
;
|
|
MAIL N XMY,XMDUZ,XMSUB,XMTEXT
|
|
S XMDUZ=.5
|
|
S (XMY(DUZ),XMY(XMDUZ))=""
|
|
S XMSUB=$S(SCF=1:$$S(22),1:$$S(24))
|
|
S XMTEXT="^TMP(""SCMC"",$J,"
|
|
D ^XMD
|
|
K ^TMP("SCMC",$J)
|
|
Q
|
|
;
|
|
SCF() I +SCF Q 1
|
|
S SCTPFLAG=1 Q 0
|
|
;
|
|
ACTTP(SCTP) Q $$ACTTP^SCMCTPU(SCTP)
|
|
;
|
|
GETPRTP(SCTP) Q $$GETPRTP^SCAPMCU2(SCTP,DT)
|
|
;
|
|
LINK() Q SCTPNM_"|"_SCTPPNM
|
|
;
|
|
AS(SC1,SC2,SC3) ; test for existing entry on filing
|
|
; input SC1 := tm pos ien
|
|
; SC2 := tm pos name
|
|
; SC3 := line reference
|
|
I 'SCF Q 0
|
|
I $D(^SCTM(404.53,"B",SC1)) D SCY($S(SC3=13:7,1:6),SC2,SC3) Q 1
|
|
Q 0
|
|
;
|
|
SCY(SC1,SC2,SC3) ;build msg array
|
|
; input SC1=line reference or text string
|
|
; SC2=name string
|
|
; SC3=line reference or text string
|
|
;
|
|
D SCII
|
|
;I SC1=6,SCTM(0) D
|
|
I SCTM(0) D
|
|
. S SCTM(0)=0
|
|
. D BLDI("")
|
|
. D BLDI($$S(5)_SCTMNM)
|
|
. Q
|
|
I SC1=7,SCTP(0) D
|
|
. S SCTP(0)=0
|
|
. D BLDI($$S(6)_SCTPNM)
|
|
D BLD($S(+SC1:$$S(SC1),1:SC1)_SC2_$S(+SC3:$$S(SC3),1:SC3))
|
|
Q
|
|
;
|
|
BLDI(SCX) ; input = text string
|
|
D BLD(SCX)
|
|
D SCII
|
|
Q
|
|
;
|
|
BLD(SCX) ; input = text string
|
|
S ^TMP("SCMC",$J,SCI)=SCX
|
|
Q
|
|
;
|
|
SCII S SCI=SCI+1
|
|
Q
|
|
;
|
|
W(SCX) ;input = 1:177 KIDS post-init, 0:177 pre-patch
|
|
;output = 1:KIDS record , 0:selected device
|
|
I SCX=21 D MES^XPDUTL(.SCY) Q
|
|
D EN^DDIOL(.SCY)
|
|
Q
|
|
;
|
|
DTU() N SCDTU200,SCDTU,SCDTUX
|
|
S SCDTU200=$G(DUZ,.5)
|
|
S SCDTUX=$$NEWPERSN^SCMCGU(SCDTU200,"SCDTU")
|
|
S SCDTUX=$S(SCDTUX>0:$P(SCDTU(SCDTU200),U),1:0)
|
|
Q $$FMTE^XLFDT($$NOW^XLFDT)_" (by: "_SCDTUX_")"
|
|
;
|
|
ENMAIN(SCX) ;
|
|
; input = 21: sd*5.3*177 preceptor filer post init
|
|
; = 23: sd*5.3*195 preceptor tester option
|
|
K SCY
|
|
S SCY(1)=""
|
|
S SCY(2)=$S(SCX=21:$$S(1),1:$$S(3))
|
|
S SCY(3)=$$DTU()
|
|
S SCY(4)=$S(SCX=21:$$S(2),1:$$S(4))
|
|
S SCY(5)=$$Q(SCX)
|
|
K ZTSK
|
|
S SCY(6)=""
|
|
D W(SCX)
|
|
Q
|
|
;
|
|
Q(SCX) ; run job in background
|
|
; input = line reference
|
|
; output = task #, report via mailman
|
|
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
|
|
S ZTRTN=$S(SCX=21:$$S(21),1:$$S(23))
|
|
S ZTDESC=$S(SCX=21:$$S(22),1:$$S(24))
|
|
S ZTDTH=$H
|
|
S ZTIO=""
|
|
D ^%ZTLOAD
|
|
Q $S(+ZTSK:": Queued - Task# "_ZTSK,1:": Not Queued!")
|
|
;
|
|
S(SCX) ;input = line reference
|
|
;output = text string
|
|
Q $P($T(T+SCX),";;",2)
|
|
;
|
|
T ;;
|
|
1 ;;Move current preceptor assignments to Preceptor History file;;
|
|
;;------------------------------------------------------------;;
|
|
;;Validate preceptor assignments vs Preceptor History requirements;;
|
|
;;----------------------------------------------------------------;;
|
|
5 ;;--> Team: ;;
|
|
;; --> Position: ;;
|
|
;; --> Preceptor: ;;
|
|
;;: 'Can Act As Preceptor' field must be 'NO'.;;
|
|
;;: cannot precept itself.;;
|
|
10 ;;: Preceptor must be PC if position is PC.;;
|
|
;;: Preceptor must be on same team.;;
|
|
;;: Preceptor must be active.;;
|
|
;;: cannot have a preceptor.;;
|
|
;;: 'Can Act As Preceptor' field must be 'YES'.;;
|
|
15 ;;: must have Staff Assigned.;;
|
|
;;Scheduling Reason file not updated... Process stopped... ;;
|
|
;;: Preceptor Link OK.;;
|
|
;;: Preceptor Link not filed << filer error >>.;;
|
|
;;: Preceptor Link filed.;;
|
|
20 ;;: No Preceptor Assignments.;;
|
|
;;ENXPD^SCMCCV3;;
|
|
;;PCMM Preceptor Migration Filer;;
|
|
;;ENPRE^SCMCCV3;;
|
|
;;PCMM Preceptor Migration Report;;
|
|
25 ;; Link Already Seeded, filer stopped.;;
|
|
;; << Background job stopped by request. >>;;
|
|
;
|