SCAPMC8 ;;bp/cmf - List of Practitioners for a Position ; 7/12/99 10:03am
;;5.3;Scheduling;**41,177**;AUG 13, 1993
;;1.0
;
PRTP(SCTP,SCDATES,SCLIST,SCERR,SCPRCPTR,SCALLHIS) ;-- list of practitioners for position (bp/cmf 177-->SCPRCPTR,SCALLHIS param added)
; input:
; SCTP = ien of TEAM POSITION[required]
; SCDATES("BEGIN") = begin date to search (inclusive)
; [default: TODAY]
; ("END") = end date to search (inclusive)
; [default: DT]
; ("INCL") = 1: only use pracitioners who were on
; team for entire date range
; 0: anytime in date range
; [default: 1]
; SCLIST= array NAME for output
; SCERR = array NAME to store error messages.
; [ex. ^TMP("ORXX",$J)]
; SCPRCPTR = 1: return preceptor sub-array in SCLIST
; [default: 0]
; SCALLHIS = 1: return unfiltered sub-array in SCLIST
; [default: 0]
;
; Output:
; SCLIST(scn) = array of practitioners
; Format:
; scn: Sequential # from 1 to n
; Piece Description
; 1 IEN of NEW PERSON file entry (#200)
; 2 Name of person
; 3 IEN of TEAM POSITION file (#404.57)
; 4 Name of Position
; 5 IEN OF USR CLASS(8930) of POSITION (404.57)
; 6 USR Class Name
; 7 IEN of STANDARD POSITION (#403.46)
; 8 Standard Role (Position) Name
; 9 Activation Date for 404.52 (not 404.59!)
; 10 Inactivation Date for 404.52
; 11 IEN of Position Asgn History (404.52)
; 12 IEN of Current(=DT) Preceptor Position
; 13 Name of Current(=DT) Preceptor Position
;
; SCLIST(scn,'PR',scn1) = sub-array of preceptors
; Format: same as SCLIST(scn) PLUS
; scn1: Sequential number from 1 to n
; Piece Description
; 14 precept start date
; 15 precept end date
; 16 IEN of Preceptor Asgn History (404.53)
;
; SCLIST("ALL",file,scn2) = sub array of all asgns within date range
; Format:
; file: 404.52 or 404.53
; scn2: Sequential number form 1 to n
; Piece Description
; 1 status int [1:active,0:inactive]
; 2 status ext ["ACTIVE","INACTIVE"]
; 3 status FM date
; 4 status ext date
; 5 file = 404.52: practitioner ien (200)
; = 404.53: prec tm pos ien (404.57)
; 6 file = 404.52: practitioner name
; = 404.53: prec tm pos name
; 7 ien of [file] history
;
; SCLIST('SCPR',sc200,sctp,scact,scn)=""
;
; SCLIST('CH')= position asgn history status
; Format:
; Piece Description
; 1 [1:corrupt hist file,0:ok]
; 2 global first act hist date
; 3 global first act hist ien
;
; SCLIST('PR','CH')= preceptor asgn history status
; Format:
; Piece Description
; 1 [1:corrupt hist file,0:ok]
; 2 global first act hist date
; 3 global first act hist ien
;
; SCERR() = Array of DIALOG file messages(errors)
; Format:
; @SCERR@(0) = Number of errors, undefined if none
; Subscript: Sequential # from 1 to n
; Piece Description
; 1 IEN of DIALOG file
; Returned: 1 if ok, 0 if error
;
; -- initialize control variables
;
ST N SCPOSNM,SCPOS0,SCEFF,SCPRTP,SCTPNODE,SCVALHIS,SCI,SCN,SCSTOP
N SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7,SCP8,SCP9,SCP10,SCP11,SCP12
N SCLSEQ,SCRN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
;
G:'$$OKDATA PRACQ ; no team pos/date array
G:'$D(^SCTM(404.52,"AIDT",SCTP)) PRACQ ; no history
;
S SCPRCPTR=$S(+$G(SCPRCPTR):1,1:0)
S SCALLHIS=$S(+$G(SCALLHIS):1,1:0)
;
S @SCLIST@("CH")=$$VALHIST^SCAPMCU5(404.52,SCTP,"SCVALHIS")
G:'$$ACTHIST^SCAPMCU5("SCVALHIS","SCDATES") PRACQ
;G:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP") PRACQ
G:'$D(SCVALHIS) TPALL ; no coherent history
;
; get static return pieces
S SCP3=SCTP ;tm pos ien
S SCTPNODE=$G(^SCTM(404.57,SCTP,0)) ;tm pos node
S SCP4=$P(SCTPNODE,U) ;tm pos name
S SCP5=$P(SCTPNODE,U,13) ;user class pointer
S SCP6=$P($G(^USR(8930,+SCP5,0)),U) ;user class name
S SCP7=$P(SCTPNODE,U,3) ;std pos pointer
S SCP8=$P($G(^SD(403.46,+SCP7,0)),U) ;std pos name
S SCP12=$$OKPREC3^SCMCLK(SCTP,DT) ;prec tm pos ien^name
;
; -- get list from position assignments
S SCRN=0
S SCEFF=-(SCEND+.000001)
F S SCEFF=$O(^SCTM(404.52,"AIDT",SCTP,1,SCEFF)) Q:'SCEFF D
. ;Q:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP")
. S SCP11="" ; posn act hist ien
. F S SCP11=$O(^SCTM(404.52,"AIDT",SCTP,1,SCEFF,SCP11),-1) Q:'SCP11 D
. . Q:'$D(SCVALHIS("I",SCP11))
. . S SCP1=+$P($G(^SCTM(404.52,SCP11,0)),U,3) ;practitioner ien
. . S SCP2=$P($G(^VA(200,+SCP1,0)),U) ;practitioner name
. . S SCI=$O(SCVALHIS("I",SCP11,0))
. . S SCP9=$O(SCVALHIS(SCI,0)) ;hist start date
. . Q:$D(@SCLIST@("SCPR",SCP1,SCTP,SCP9))
. . S SCP10=$P(SCVALHIS(SCI,SCP9,SCP11),U) ;hist end date
. . Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCP9,SCP10)
. . S SCRN=SCRN+1
. . S @SCLIST@(0)=SCRN
. . S @SCLIST@("SCPR",SCP1,SCTP,SCP9,SCRN)=""
. . 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
. . Q
. Q
;
I $G(@SCLIST@(0))>0,+SCPRCPTR D PRCTP^SCAPMC8P
TPALL I +SCALLHIS D TPALL^SCAPMC8A(404.52)
;
PRACQ Q $G(SCERR(0))<1 ;bp/djb 7/12/99
;
OKDATA() ;check/setup variables - return 1 if ok/0 if error
N SCOK
S SCOK=1
D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
IF '$D(^SCTM(404.57,+$G(SCTP),0)) D S SCOK=0
. S SCPARM("POSITION")=$G(SCTP,"Undefined")
. D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
; -- is it a valid TEAM ien passed (Error # 4045101 in DIALOG file)
IF '$D(^SCTM(404.57,+$G(SCTP),0))!('$D(SCDATES)) D S SCOK=0
. S SCPARM("POSITION")=$S('$D(SCTP):"Undefined",1:SCTP)
. S SCPARM("DATES")=$S('$D(SCDATES):"Undefined",1:SCDATES)
. D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
Q SCOK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC8 7017 printed Dec 13, 2024@02:38:11 Page 2
SCAPMC8 ;;bp/cmf - List of Practitioners for a Position ; 7/12/99 10:03am
+1 ;;5.3;Scheduling;**41,177**;AUG 13, 1993
+2 ;;1.0
+3 ;
PRTP(SCTP,SCDATES,SCLIST,SCERR,SCPRCPTR,SCALLHIS) ;-- list of practitioners for position (bp/cmf 177-->SCPRCPTR,SCALLHIS param added)
+1 ; input:
+2 ; SCTP = ien of TEAM POSITION[required]
+3 ; SCDATES("BEGIN") = begin date to search (inclusive)
+4 ; [default: TODAY]
+5 ; ("END") = end date to search (inclusive)
+6 ; [default: DT]
+7 ; ("INCL") = 1: only use pracitioners who were on
+8 ; team for entire date range
+9 ; 0: anytime in date range
+10 ; [default: 1]
+11 ; SCLIST= array NAME for output
+12 ; SCERR = array NAME to store error messages.
+13 ; [ex. ^TMP("ORXX",$J)]
+14 ; SCPRCPTR = 1: return preceptor sub-array in SCLIST
+15 ; [default: 0]
+16 ; SCALLHIS = 1: return unfiltered sub-array in SCLIST
+17 ; [default: 0]
+18 ;
+19 ; Output:
+20 ; SCLIST(scn) = array of practitioners
+21 ; Format:
+22 ; scn: Sequential # from 1 to n
+23 ; Piece Description
+24 ; 1 IEN of NEW PERSON file entry (#200)
+25 ; 2 Name of person
+26 ; 3 IEN of TEAM POSITION file (#404.57)
+27 ; 4 Name of Position
+28 ; 5 IEN OF USR CLASS(8930) of POSITION (404.57)
+29 ; 6 USR Class Name
+30 ; 7 IEN of STANDARD POSITION (#403.46)
+31 ; 8 Standard Role (Position) Name
+32 ; 9 Activation Date for 404.52 (not 404.59!)
+33 ; 10 Inactivation Date for 404.52
+34 ; 11 IEN of Position Asgn History (404.52)
+35 ; 12 IEN of Current(=DT) Preceptor Position
+36 ; 13 Name of Current(=DT) Preceptor Position
+37 ;
+38 ; SCLIST(scn,'PR',scn1) = sub-array of preceptors
+39 ; Format: same as SCLIST(scn) PLUS
+40 ; scn1: Sequential number from 1 to n
+41 ; Piece Description
+42 ; 14 precept start date
+43 ; 15 precept end date
+44 ; 16 IEN of Preceptor Asgn History (404.53)
+45 ;
+46 ; SCLIST("ALL",file,scn2) = sub array of all asgns within date range
+47 ; Format:
+48 ; file: 404.52 or 404.53
+49 ; scn2: Sequential number form 1 to n
+50 ; Piece Description
+51 ; 1 status int [1:active,0:inactive]
+52 ; 2 status ext ["ACTIVE","INACTIVE"]
+53 ; 3 status FM date
+54 ; 4 status ext date
+55 ; 5 file = 404.52: practitioner ien (200)
+56 ; = 404.53: prec tm pos ien (404.57)
+57 ; 6 file = 404.52: practitioner name
+58 ; = 404.53: prec tm pos name
+59 ; 7 ien of [file] history
+60 ;
+61 ; SCLIST('SCPR',sc200,sctp,scact,scn)=""
+62 ;
+63 ; SCLIST('CH')= position asgn history status
+64 ; Format:
+65 ; Piece Description
+66 ; 1 [1:corrupt hist file,0:ok]
+67 ; 2 global first act hist date
+68 ; 3 global first act hist ien
+69 ;
+70 ; SCLIST('PR','CH')= preceptor asgn history status
+71 ; Format:
+72 ; Piece Description
+73 ; 1 [1:corrupt hist file,0:ok]
+74 ; 2 global first act hist date
+75 ; 3 global first act hist ien
+76 ;
+77 ; SCERR() = Array of DIALOG file messages(errors)
+78 ; Format:
+79 ; @SCERR@(0) = Number of errors, undefined if none
+80 ; Subscript: Sequential # from 1 to n
+81 ; Piece Description
+82 ; 1 IEN of DIALOG file
+83 ; Returned: 1 if ok, 0 if error
+84 ;
+85 ; -- initialize control variables
+86 ;
ST NEW SCPOSNM,SCPOS0,SCEFF,SCPRTP,SCTPNODE,SCVALHIS,SCI,SCN,SCSTOP
+1 NEW SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7,SCP8,SCP9,SCP10,SCP11,SCP12
+2 NEW SCLSEQ,SCRN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
+3 ;
+4 ; no team pos/date array
if '$$OKDATA
GOTO PRACQ
+5 ; no history
if '$DATA(^SCTM(404.52,"AIDT",SCTP))
GOTO PRACQ
+6 ;
+7 SET SCPRCPTR=$SELECT(+$GET(SCPRCPTR):1,1:0)
+8 SET SCALLHIS=$SELECT(+$GET(SCALLHIS):1,1:0)
+9 ;
+10 SET @SCLIST@("CH")=$$VALHIST^SCAPMCU5(404.52,SCTP,"SCVALHIS")
+11 if '$$ACTHIST^SCAPMCU5("SCVALHIS","SCDATES")
GOTO PRACQ
+12 ;G:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP") PRACQ
+13 ; no coherent history
if '$DATA(SCVALHIS)
GOTO TPALL
+14 ;
+15 ; get static return pieces
+16 ;tm pos ien
SET SCP3=SCTP
+17 ;tm pos node
SET SCTPNODE=$GET(^SCTM(404.57,SCTP,0))
+18 ;tm pos name
SET SCP4=$PIECE(SCTPNODE,U)
+19 ;user class pointer
SET SCP5=$PIECE(SCTPNODE,U,13)
+20 ;user class name
SET SCP6=$PIECE($GET(^USR(8930,+SCP5,0)),U)
+21 ;std pos pointer
SET SCP7=$PIECE(SCTPNODE,U,3)
+22 ;std pos name
SET SCP8=$PIECE($GET(^SD(403.46,+SCP7,0)),U)
+23 ;prec tm pos ien^name
SET SCP12=$$OKPREC3^SCMCLK(SCTP,DT)
+24 ;
+25 ; -- get list from position assignments
+26 SET SCRN=0
+27 SET SCEFF=-(SCEND+.000001)
+28 FOR
SET SCEFF=$ORDER(^SCTM(404.52,"AIDT",SCTP,1,SCEFF))
if 'SCEFF
QUIT
Begin DoDot:1
+29 ;Q:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP")
+30 ; posn act hist ien
SET SCP11=""
+31 FOR
SET SCP11=$ORDER(^SCTM(404.52,"AIDT",SCTP,1,SCEFF,SCP11),-1)
if 'SCP11
QUIT
Begin DoDot:2
+32 if '$DATA(SCVALHIS("I",SCP11))
QUIT
+33 ;practitioner ien
SET SCP1=+$PIECE($GET(^SCTM(404.52,SCP11,0)),U,3)
+34 ;practitioner name
SET SCP2=$PIECE($GET(^VA(200,+SCP1,0)),U)
+35 SET SCI=$ORDER(SCVALHIS("I",SCP11,0))
+36 ;hist start date
SET SCP9=$ORDER(SCVALHIS(SCI,0))
+37 if $DATA(@SCLIST@("SCPR",SCP1,SCTP,SCP9))
QUIT
+38 ;hist end date
SET SCP10=$PIECE(SCVALHIS(SCI,SCP9,SCP11),U)
+39 if '$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCP9,SCP10)
QUIT
+40 SET SCRN=SCRN+1
+41 SET @SCLIST@(0)=SCRN
+42 SET @SCLIST@("SCPR",SCP1,SCTP,SCP9,SCRN)=""
+43 SET @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
+44 QUIT
End DoDot:2
+45 QUIT
End DoDot:1
+46 ;
+47 IF $GET(@SCLIST@(0))>0
IF +SCPRCPTR
DO PRCTP^SCAPMC8P
TPALL IF +SCALLHIS
DO TPALL^SCAPMC8A(404.52)
+1 ;
PRACQ ;bp/djb 7/12/99
QUIT $GET(SCERR(0))<1
+1 ;
OKDATA() ;check/setup variables - return 1 if ok/0 if error
+1 NEW SCOK
+2 SET SCOK=1
+3 ; set default dates & error array (if undefined)
DO INIT^SCAPMCU1(.SCOK)
+4 IF '$DATA(^SCTM(404.57,+$GET(SCTP),0))
Begin DoDot:1
+5 SET SCPARM("POSITION")=$GET(SCTP,"Undefined")
+6 DO ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+7 ; -- is it a valid TEAM ien passed (Error # 4045101 in DIALOG file)
+8 IF '$DATA(^SCTM(404.57,+$GET(SCTP),0))!('$DATA(SCDATES))
Begin DoDot:1
+9 SET SCPARM("POSITION")=$SELECT('$DATA(SCTP):"Undefined",1:SCTP)
+10 SET SCPARM("DATES")=$SELECT('$DATA(SCDATES):"Undefined",1:SCDATES)
+11 DO ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+12 QUIT SCOK
+13 ;
