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

SCAPMC8.m

Go to the documentation of this file.
  1. SCAPMC8 ;;bp/cmf - List of Practitioners for a Position ; 7/12/99 10:03am
  1. ;;5.3;Scheduling;**41,177**;AUG 13, 1993
  1. ;;1.0
  1. ;
  1. PRTP(SCTP,SCDATES,SCLIST,SCERR,SCPRCPTR,SCALLHIS) ;-- list of practitioners for position (bp/cmf 177-->SCPRCPTR,SCALLHIS param added)
  1. ; input:
  1. ; SCTP = ien of TEAM POSITION[required]
  1. ; SCDATES("BEGIN") = begin date to search (inclusive)
  1. ; [default: TODAY]
  1. ; ("END") = end date to search (inclusive)
  1. ; [default: DT]
  1. ; ("INCL") = 1: only use pracitioners who were on
  1. ; team for entire date range
  1. ; 0: anytime in date range
  1. ; [default: 1]
  1. ; SCLIST= array NAME for output
  1. ; SCERR = array NAME to store error messages.
  1. ; [ex. ^TMP("ORXX",$J)]
  1. ; SCPRCPTR = 1: return preceptor sub-array in SCLIST
  1. ; [default: 0]
  1. ; SCALLHIS = 1: return unfiltered sub-array in SCLIST
  1. ; [default: 0]
  1. ;
  1. ; Output:
  1. ; SCLIST(scn) = array of practitioners
  1. ; Format:
  1. ; scn: Sequential # from 1 to n
  1. ; Piece Description
  1. ; 1 IEN of NEW PERSON file entry (#200)
  1. ; 2 Name of person
  1. ; 3 IEN of TEAM POSITION file (#404.57)
  1. ; 4 Name of Position
  1. ; 5 IEN OF USR CLASS(8930) of POSITION (404.57)
  1. ; 6 USR Class Name
  1. ; 7 IEN of STANDARD POSITION (#403.46)
  1. ; 8 Standard Role (Position) Name
  1. ; 9 Activation Date for 404.52 (not 404.59!)
  1. ; 10 Inactivation Date for 404.52
  1. ; 11 IEN of Position Asgn History (404.52)
  1. ; 12 IEN of Current(=DT) Preceptor Position
  1. ; 13 Name of Current(=DT) Preceptor Position
  1. ;
  1. ; SCLIST(scn,'PR',scn1) = sub-array of preceptors
  1. ; Format: same as SCLIST(scn) PLUS
  1. ; scn1: Sequential number from 1 to n
  1. ; Piece Description
  1. ; 14 precept start date
  1. ; 15 precept end date
  1. ; 16 IEN of Preceptor Asgn History (404.53)
  1. ;
  1. ; SCLIST("ALL",file,scn2) = sub array of all asgns within date range
  1. ; Format:
  1. ; file: 404.52 or 404.53
  1. ; scn2: Sequential number form 1 to n
  1. ; Piece Description
  1. ; 1 status int [1:active,0:inactive]
  1. ; 2 status ext ["ACTIVE","INACTIVE"]
  1. ; 3 status FM date
  1. ; 4 status ext date
  1. ; 5 file = 404.52: practitioner ien (200)
  1. ; = 404.53: prec tm pos ien (404.57)
  1. ; 6 file = 404.52: practitioner name
  1. ; = 404.53: prec tm pos name
  1. ; 7 ien of [file] history
  1. ;
  1. ; SCLIST('SCPR',sc200,sctp,scact,scn)=""
  1. ;
  1. ; SCLIST('CH')= position asgn history status
  1. ; Format:
  1. ; Piece Description
  1. ; 1 [1:corrupt hist file,0:ok]
  1. ; 2 global first act hist date
  1. ; 3 global first act hist ien
  1. ;
  1. ; SCLIST('PR','CH')= preceptor asgn history status
  1. ; Format:
  1. ; Piece Description
  1. ; 1 [1:corrupt hist file,0:ok]
  1. ; 2 global first act hist date
  1. ; 3 global first act hist ien
  1. ;
  1. ; SCERR() = Array of DIALOG file messages(errors)
  1. ; Format:
  1. ; @SCERR@(0) = Number of errors, undefined if none
  1. ; Subscript: Sequential # from 1 to n
  1. ; Piece Description
  1. ; 1 IEN of DIALOG file
  1. ; Returned: 1 if ok, 0 if error
  1. ;
  1. ; -- initialize control variables
  1. ;
  1. ST N SCPOSNM,SCPOS0,SCEFF,SCPRTP,SCTPNODE,SCVALHIS,SCI,SCN,SCSTOP
  1. N SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7,SCP8,SCP9,SCP10,SCP11,SCP12
  1. N SCLSEQ,SCRN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
  1. ;
  1. G:'$$OKDATA PRACQ ; no team pos/date array
  1. G:'$D(^SCTM(404.52,"AIDT",SCTP)) PRACQ ; no history
  1. ;
  1. S SCPRCPTR=$S(+$G(SCPRCPTR):1,1:0)
  1. S SCALLHIS=$S(+$G(SCALLHIS):1,1:0)
  1. ;
  1. S @SCLIST@("CH")=$$VALHIST^SCAPMCU5(404.52,SCTP,"SCVALHIS")
  1. G:'$$ACTHIST^SCAPMCU5("SCVALHIS","SCDATES") PRACQ
  1. ;G:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP") PRACQ
  1. G:'$D(SCVALHIS) TPALL ; no coherent history
  1. ;
  1. ; get static return pieces
  1. S SCP3=SCTP ;tm pos ien
  1. S SCTPNODE=$G(^SCTM(404.57,SCTP,0)) ;tm pos node
  1. S SCP4=$P(SCTPNODE,U) ;tm pos name
  1. S SCP5=$P(SCTPNODE,U,13) ;user class pointer
  1. S SCP6=$P($G(^USR(8930,+SCP5,0)),U) ;user class name
  1. S SCP7=$P(SCTPNODE,U,3) ;std pos pointer
  1. S SCP8=$P($G(^SD(403.46,+SCP7,0)),U) ;std pos name
  1. S SCP12=$$OKPREC3^SCMCLK(SCTP,DT) ;prec tm pos ien^name
  1. ;
  1. ; -- get list from position assignments
  1. S SCRN=0
  1. S SCEFF=-(SCEND+.000001)
  1. F S SCEFF=$O(^SCTM(404.52,"AIDT",SCTP,1,SCEFF)) Q:'SCEFF D
  1. . ;Q:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP")
  1. . S SCP11="" ; posn act hist ien
  1. . F S SCP11=$O(^SCTM(404.52,"AIDT",SCTP,1,SCEFF,SCP11),-1) Q:'SCP11 D
  1. . . Q:'$D(SCVALHIS("I",SCP11))
  1. . . S SCP1=+$P($G(^SCTM(404.52,SCP11,0)),U,3) ;practitioner ien
  1. . . S SCP2=$P($G(^VA(200,+SCP1,0)),U) ;practitioner name
  1. . . S SCI=$O(SCVALHIS("I",SCP11,0))
  1. . . S SCP9=$O(SCVALHIS(SCI,0)) ;hist start date
  1. . . Q:$D(@SCLIST@("SCPR",SCP1,SCTP,SCP9))
  1. . . S SCP10=$P(SCVALHIS(SCI,SCP9,SCP11),U) ;hist end date
  1. . . Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCP9,SCP10)
  1. . . S SCRN=SCRN+1
  1. . . S @SCLIST@(0)=SCRN
  1. . . S @SCLIST@("SCPR",SCP1,SCTP,SCP9,SCRN)=""
  1. . . S @SCLIST@(SCRN)=SCP1_U_SCP2_U_SCP3_U_SCP4_U_SCP5_U_SCP6_U_SCP7_U_SCP8_U_SCP9_U_SCP10_U_SCP11_U_SCP12
  1. . . Q
  1. . Q
  1. ;
  1. I $G(@SCLIST@(0))>0,+SCPRCPTR D PRCTP^SCAPMC8P
  1. TPALL I +SCALLHIS D TPALL^SCAPMC8A(404.52)
  1. ;
  1. PRACQ Q $G(SCERR(0))<1 ;bp/djb 7/12/99
  1. ;
  1. OKDATA() ;check/setup variables - return 1 if ok/0 if error
  1. N SCOK
  1. S SCOK=1
  1. D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
  1. IF '$D(^SCTM(404.57,+$G(SCTP),0)) D S SCOK=0
  1. . S SCPARM("POSITION")=$G(SCTP,"Undefined")
  1. . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
  1. ; -- is it a valid TEAM ien passed (Error # 4045101 in DIALOG file)
  1. IF '$D(^SCTM(404.57,+$G(SCTP),0))!('$D(SCDATES)) D S SCOK=0
  1. . S SCPARM("POSITION")=$S('$D(SCTP):"Undefined",1:SCTP)
  1. . S SCPARM("DATES")=$S('$D(SCDATES):"Undefined",1:SCDATES)
  1. . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
  1. Q SCOK
  1. ;