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. >>;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCCV3 5826 printed Apr 09, 2024@21:55:29 Page 2
SCMCCV3 ;bp/cmf - 195 Test/177 File - 404.57 preceptors to 404.53 ; Sep 1999
+1 ;;5.3;Scheduling;**195,177**;AUG 13, 1993
+2 ;
+3 QUIT
+4 ;
ENXPD DO EN(1)
QUIT
+1 ;
ENPRE DO EN(0)
QUIT
+1 ;
EN(SCF) ;input = 1: Postinit(file)
+1 ; = 0: PrePatch(validate)
+2 ;
+3 NEW SCY,SCI,SCTM,SCTP,SCREASON,SCZSTOP
+4 KILL ^TMP("SCMC",$JOB)
+5 SET SCI=1
+6 DO BLDI("")
+7 DO BLDI($SELECT(SCF:$$S(1),1:$$S(3)))
+8 DO BLDI($$DTU())
+9 DO BLDI($SELECT(SCF:$$S(2),1:$$S(4)))
+10 DO BLDI("")
+11 IF SCF
Begin DoDot:1
+12 SET SCREASON=+$$FIND1^DIC(403.44,"","X","ACTIVATE PRECEPTOR LINK")
+13 QUIT
End DoDot:1
IF 'SCREASON
DO BLD($$S(16))
GOTO MAIL
+14 ;
LOOP SET SCZSTOP=0
+1 SET SCTMNM=""
+2 FOR
SET SCTMNM=$ORDER(^SCTM(404.51,"B",SCTMNM))
if (SCTMNM="")!(SCZSTOP)
QUIT
Begin DoDot:1
+3 SET SCZSTOP=$SELECT($$S^%ZTLOAD:1,1:0)
+4 if SCZSTOP
QUIT
+5 SET SCTM=$ORDER(^SCTM(404.51,"B",SCTMNM,0))
+6 ;team inactive
if '+$$ACTTM^SCMCTMU(SCTM)
QUIT
+7 ;no team positions
if '$DATA(^SCTM(404.57,"C",SCTM))
QUIT
+8 SET SCTM(0)=1
+9 ;team position ien
SET SCTP=0
+10 FOR
SET SCTP=$ORDER(^SCTM(404.57,"C",SCTM,SCTP))
if ('SCTP)!(SCZSTOP)
QUIT
Begin DoDot:2
+11 SET SCZSTOP=$SELECT($$S^%ZTLOAD:1,1:0)
+12 if SCZSTOP
QUIT
+13 ;team position node
SET SCTP0=^SCTM(404.57,SCTP,0)
+14 ;no preceptor entry
if '+$PIECE(SCTP0,U,10)
QUIT
+15 SET SCTPNM=$PIECE(SCTP0,U)
+16 SET SCTP(0)=1
+17 ;already seeded
if $$AS(SCTP,SCTPNM,25)
QUIT
+18 ;not active
if '+$$ACTTP(SCTP)
QUIT
+19 SET SCTPFLAG=0
+20 DO SCII
+21 IF +$PIECE(SCTP0,U,12)
DO SCY(6,SCTPNM,8)
if $$SCF()
QUIT
+22 ;preceptor team position ien
SET SCTPP=+$PIECE(SCTP0,U,10)
+23 IF SCTPP=SCTP
DO SCY(6,SCTPNM,9)
if $$SCF()
QUIT
+24 IF '+$$GETPRTP(SCTP)
DO SCY(6,SCTPNM,15)
if $$SCF()
QUIT
+25 ;preceptor team position node
SET SCTPP0=^SCTM(404.57,SCTPP,0)
+26 SET SCTPPNM=$PIECE(SCTPP0,U)
+27 IF (+$PIECE(SCTP0,U,4))&('+$PIECE(SCTPP0,U,4))
DO SCY(7,SCTPPNM,10)
if $$SCF()
QUIT
+28 IF $PIECE(SCTP0,U,2)'=$PIECE(SCTPP0,U,2)
DO SCY(7,SCTPPNM,11)
if $$SCF()
QUIT
+29 IF '+$$ACTTP(SCTPP)
DO SCY(7,SCTPPNM,12)
if $$SCF()
QUIT
+30 IF +$PIECE(SCTPP0,U,10)
DO SCY(7,SCTPPNM,13)
if $$SCF()
QUIT
+31 if $$AS(SCTPP,SCTPPNM,13)
QUIT
+32 IF '+$PIECE(SCTPP0,U,12)
DO SCY(7,SCTPPNM,14)
if $$SCF()
QUIT
+33 IF '+$$GETPRTP(SCTPP)
DO SCY(7,SCTPPNM,15)
if $$SCF()
QUIT
+34 IF 'SCF
Begin DoDot:3
+35 IF 'SCTPFLAG
DO SCY(6,$$LINK(),17)
+36 QUIT
End DoDot:3
QUIT
+37 KILL SCFDA,SCERR
+38 SET SCFDA(1,404.53,"+1,",.01)=SCTP
+39 SET SCFDA(1,404.53,"+1,",.02)=DT
+40 SET SCFDA(1,404.53,"+1,",.04)=1
+41 SET SCFDA(1,404.53,"+1,",.05)=SCREASON
+42 SET SCFDA(1,404.53,"+1,",.06)=SCTPP
+43 DO UPDATE^DIE("","SCFDA(1)","","SCERR")
+44 IF $DATA(SCERR)
DO SCY(7,$$LINK(),18)
+45 IF '$TEST
DO SCY(7,$$LINK(),19)
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
+48 IF SCZSTOP
DO BLDI(0)
DO BLD(26)
+49 ;
MAIL NEW XMY,XMDUZ,XMSUB,XMTEXT
+1 SET XMDUZ=.5
+2 SET (XMY(DUZ),XMY(XMDUZ))=""
+3 SET XMSUB=$SELECT(SCF=1:$$S(22),1:$$S(24))
+4 SET XMTEXT="^TMP(""SCMC"",$J,"
+5 DO ^XMD
+6 KILL ^TMP("SCMC",$JOB)
+7 QUIT
+8 ;
SCF() IF +SCF
QUIT 1
+1 SET SCTPFLAG=1
QUIT 0
+2 ;
ACTTP(SCTP) QUIT $$ACTTP^SCMCTPU(SCTP)
+1 ;
GETPRTP(SCTP) QUIT $$GETPRTP^SCAPMCU2(SCTP,DT)
+1 ;
LINK() QUIT SCTPNM_"|"_SCTPPNM
+1 ;
AS(SC1,SC2,SC3) ; test for existing entry on filing
+1 ; input SC1 := tm pos ien
+2 ; SC2 := tm pos name
+3 ; SC3 := line reference
+4 IF 'SCF
QUIT 0
+5 IF $DATA(^SCTM(404.53,"B",SC1))
DO SCY($SELECT(SC3=13:7,1:6),SC2,SC3)
QUIT 1
+6 QUIT 0
+7 ;
SCY(SC1,SC2,SC3) ;build msg array
+1 ; input SC1=line reference or text string
+2 ; SC2=name string
+3 ; SC3=line reference or text string
+4 ;
+5 DO SCII
+6 ;I SC1=6,SCTM(0) D
+7 IF SCTM(0)
Begin DoDot:1
+8 SET SCTM(0)=0
+9 DO BLDI("")
+10 DO BLDI($$S(5)_SCTMNM)
+11 QUIT
End DoDot:1
+12 IF SC1=7
IF SCTP(0)
Begin DoDot:1
+13 SET SCTP(0)=0
+14 DO BLDI($$S(6)_SCTPNM)
End DoDot:1
+15 DO BLD($SELECT(+SC1:$$S(SC1),1:SC1)_SC2_$SELECT(+SC3:$$S(SC3),1:SC3))
+16 QUIT
+17 ;
BLDI(SCX) ; input = text string
+1 DO BLD(SCX)
+2 DO SCII
+3 QUIT
+4 ;
BLD(SCX) ; input = text string
+1 SET ^TMP("SCMC",$JOB,SCI)=SCX
+2 QUIT
+3 ;
SCII SET SCI=SCI+1
+1 QUIT
+2 ;
W(SCX) ;input = 1:177 KIDS post-init, 0:177 pre-patch
+1 ;output = 1:KIDS record , 0:selected device
+2 IF SCX=21
DO MES^XPDUTL(.SCY)
QUIT
+3 DO EN^DDIOL(.SCY)
+4 QUIT
+5 ;
DTU() NEW SCDTU200,SCDTU,SCDTUX
+1 SET SCDTU200=$GET(DUZ,.5)
+2 SET SCDTUX=$$NEWPERSN^SCMCGU(SCDTU200,"SCDTU")
+3 SET SCDTUX=$SELECT(SCDTUX>0:$PIECE(SCDTU(SCDTU200),U),1:0)
+4 QUIT $$FMTE^XLFDT($$NOW^XLFDT)_" (by: "_SCDTUX_")"
+5 ;
ENMAIN(SCX) ;
+1 ; input = 21: sd*5.3*177 preceptor filer post init
+2 ; = 23: sd*5.3*195 preceptor tester option
+3 KILL SCY
+4 SET SCY(1)=""
+5 SET SCY(2)=$SELECT(SCX=21:$$S(1),1:$$S(3))
+6 SET SCY(3)=$$DTU()
+7 SET SCY(4)=$SELECT(SCX=21:$$S(2),1:$$S(4))
+8 SET SCY(5)=$$Q(SCX)
+9 KILL ZTSK
+10 SET SCY(6)=""
+11 DO W(SCX)
+12 QUIT
+13 ;
Q(SCX) ; run job in background
+1 ; input = line reference
+2 ; output = task #, report via mailman
+3 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
+4 SET ZTRTN=$SELECT(SCX=21:$$S(21),1:$$S(23))
+5 SET ZTDESC=$SELECT(SCX=21:$$S(22),1:$$S(24))
+6 SET ZTDTH=$HOROLOG
+7 SET ZTIO=""
+8 DO ^%ZTLOAD
+9 QUIT $SELECT(+ZTSK:": Queued - Task# "_ZTSK,1:": Not Queued!")
+10 ;
S(SCX) ;input = line reference
+1 ;output = text string
+2 QUIT $PIECE($TEXT(T+SCX),";;",2)
+3 ;
T ;;
1 ;;Move current preceptor assignments to Preceptor History file;;
+1 ;;------------------------------------------------------------;;
+2 ;;Validate preceptor assignments vs Preceptor History requirements;;
+3 ;;----------------------------------------------------------------;;
5 ;;--> Team: ;;
+1 ;; --> Position: ;;
+2 ;; --> Preceptor: ;;
+3 ;;: 'Can Act As Preceptor' field must be 'NO'.;;
+4 ;;: cannot precept itself.;;
10 ;;: Preceptor must be PC if position is PC.;;
+1 ;;: Preceptor must be on same team.;;
+2 ;;: Preceptor must be active.;;
+3 ;;: cannot have a preceptor.;;
+4 ;;: 'Can Act As Preceptor' field must be 'YES'.;;
15 ;;: must have Staff Assigned.;;
+1 ;;Scheduling Reason file not updated... Process stopped... ;;
+2 ;;: Preceptor Link OK.;;
+3 ;;: Preceptor Link not filed << filer error >>.;;
+4 ;;: Preceptor Link filed.;;
20 ;;: No Preceptor Assignments.;;
+1 ;;ENXPD^SCMCCV3;;
+2 ;;PCMM Preceptor Migration Filer;;
+3 ;;ENPRE^SCMCCV3;;
+4 ;;PCMM Preceptor Migration Report;;
25 ;; Link Already Seeded, filer stopped.;;
+1 ;; << Background job stopped by request. >>;
+2 ;
