source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCCV3.m@ 794

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.  >>;;
 ;