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

SCMCTPU3.m

Go to the documentation of this file.
  1. SCMCTPU3 ;ALB/MJK - Team Position Utility ; 1 SEP 98
  1. ;;5.3;Scheduling;**148**;AUG 13,1993
  1. ;
  1. EN ; -- main entry point to find pat position assignments w/o team assignment
  1. N SCMODE,SCTMLST,SCTSK
  1. ;
  1. ; -- ask user which mode (diagnosis vs. fix)
  1. S SCMODE=$$MODE()
  1. IF 'SCMODE G ENQ
  1. ;
  1. ; -- ask user for teams
  1. IF '$$TEAM() G ENQ
  1. ;
  1. ; -- queue job to run
  1. S SCTSK=$$QUE()
  1. IF SCTSK'="" D
  1. . W !!,">>> Task#: ",SCTSK
  1. . W !!," This task will send a MailMan message to you containing"
  1. . W !," the results of the position assignment review.",!
  1. D PAUSE
  1. ENQ Q
  1. ;
  1. MODE() ; -- get mode from user (1 - diagnostic 2 - fix 0 - abort)
  1. Q 1 ; -- fix mode (2) is a future
  1. ;
  1. TEAM() ; -- get teams from user
  1. N Y,DIC,VAUTVB,VAUTSTR,VAUTINI
  1. S VAUTVB="SCTMLST"
  1. S VAUTSTR="Team"
  1. S VAUTNI=2
  1. S DIC="^SCTM(404.51,"
  1. D FIRST^VAUTOMA
  1. Q $S(Y=-1:0,1:1)
  1. ;
  1. QUE() ; -- setup task and queue job to run
  1. ;D START Q 99999 ; -- for interactive testing
  1. N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
  1. S ZTRTN="START^SCMCTPU3"
  1. S ZTDESC="Patient Team Position Assignment Review"
  1. S ZTDTH=$H
  1. S ZTIO=""
  1. F X="SCTMLST(","SCTMLST","SCMODE" S ZTSAVE(X)=""
  1. D ^%ZTLOAD
  1. Q $G(ZTSK)
  1. ;
  1. START ; -- entry point for queued job
  1. ;
  1. N SCSTOP,SCER,SCERTMP,SCNT
  1. N SCTP,SCTP0,SCTPNM
  1. N SCTM,SCTM0,SCTMNM
  1. N SCPT,SCPT0,SCPTNM,SCPTID
  1. N SCTPA,SCTPA0,SCTPASDT,SCTPUNDT
  1. N SCTMA,SCTMA0,SCTMASDT,SCTMUNDT
  1. ;
  1. S SCERTMP=$NA(^TMP("SCTP DANGLERS",$J))
  1. K @SCERTMP
  1. ;
  1. ; -- is 'all' teams selected build array
  1. IF SCTMLST=1 D
  1. . S SCTM=0
  1. . F S SCTM=$O(^SCTM(404.51,SCTM)) Q:'SCTM S X=$G(^SCTM(404.51,SCTM,0)) S SCTMLST(SCTM)=$P(X,U)
  1. ;
  1. ; -- loop through entire team position assignment file
  1. S (SCSTOP,SCTPA)=0
  1. F S SCTPA=$O(^SCPT(404.43,SCTPA)) Q:'SCTPA D Q:SCSTOP
  1. . IF $$S^%ZTLOAD() S (SCSTOP,ZTSTOP)=1 Q
  1. . N SCERAR
  1. . ;
  1. . ; -- get data
  1. . D DATA(SCTPA)
  1. . ;
  1. . ; -- quit if team not selected by user
  1. . IF '$D(SCTMLST(SCTM)) Q
  1. . ;
  1. . D CNT("TOTAL")
  1. . ;
  1. . ; -- if postion assigned date >= team assigned date
  1. . ; and
  1. . ; position unassigned date <= team unassigned date
  1. . ; then entry is good
  1. . ;
  1. . ; else
  1. . ; process error
  1. . ;
  1. . IF SCTPASDT>SCTMASDT!(SCTPASDT=SCTMASDT) D
  1. . . IF SCTPUNDT<SCTMUNDT!(SCTPUNDT=SCTMUNDT) D
  1. . . . D CNT("OK")
  1. . . . Q
  1. . . ; -- position unassign date > team unassign date
  1. . . ELSE D
  1. . . . D ERR(2)
  1. . . . Q
  1. . . Q
  1. . ; -- position assign date < team assign date
  1. . ELSE D
  1. . . D ERR(1)
  1. . . Q
  1. . ;
  1. . IF $O(SCERAR(0)) D CNT("BAD"),SET
  1. . ; -- check if user asked job to stop
  1. . Q
  1. ;
  1. IF 'SCSTOP D BULL^SCMCTPU4
  1. ;
  1. K @SCERTMP
  1. Q
  1. ;
  1. CNT(TYPE) ; -- set counter
  1. S SCNT(TYPE)=$G(SCNT(TYPE))+1
  1. Q
  1. ;
  1. ERR(NUMBER) ; -- set error array
  1. S SCERAR(NUMBER)=""
  1. Q
  1. ;
  1. SET ; -- set tmp for report
  1. N SCER
  1. S SCER=0
  1. F S SCER=$O(SCERAR(SCER)) Q:'SCER D
  1. . S @SCERTMP@(SCTMNM_SCTM,SCTPNM_SCTP,SCPTNM_SCPT,SCTPASDT,SCTPA,SCER)=""
  1. Q
  1. ;
  1. DATA(SCTPA) ; -- get team, position, tm pos assign, tm assignment & patient data
  1. ; input: SCPTA := ien to patient team position assignment (404.43)
  1. ;
  1. ; -- Team Position Assignment (TPA) data
  1. S SCTPA0=$G(^SCPT(404.43,SCTPA,0))
  1. S SCTPASDT=+$P(SCTPA0,U,3)
  1. S SCTPUNDT=$S($P(SCTPA0,U,4):$P(SCTPA0,U,4),1:9999999)
  1. ;
  1. ; -- Team Position (TP) data
  1. S SCTP=+$P(SCTPA0,U,2)
  1. S SCTP0=$G(^SCTM(404.57,SCTP,0))
  1. S SCTPNM=$P(SCTP0,U)
  1. ;
  1. ; -- TeaM Assignment (TMA) data
  1. S SCTMA=+SCTPA0
  1. S SCTMA0=$G(^SCPT(404.42,SCTMA,0))
  1. S SCTMASDT=+$P(SCTMA0,U,2)
  1. S SCTMUNDT=$S($P(SCTMA0,U,9):$P(SCTMA0,U,9),1:9999999)
  1. ;
  1. ; -- TeaM (TM) data
  1. S SCTM=+$P(SCTMA0,U,3)
  1. S SCTM0=$G(^SCTM(404.51,SCTM,0))
  1. S SCTMNM=$P(SCTM0,U)
  1. ;
  1. ; -- PaTient (PT) data
  1. S SCPT=+SCTMA0
  1. S SCPT0=$G(^DPT(SCPT,0))
  1. S SCPTNM=$P(SCPT0,U)
  1. N DFN,VA
  1. S DFN=SCPT D PID^VADPT6
  1. S SCPTID=VA("BID")
  1. Q
  1. ;
  1. PAUSE ; -- pause
  1. N DIR,Y
  1. S DIR(0)="EA"
  1. S DIR("A")=">>> Press RETURN to continue: "
  1. D ^DIR
  1. Q