- 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 Jan 18, 2025@03:41:10 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 ;