Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCCV3

SCMCCV3.m

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