- 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 Jan 18, 2025@03:39:20 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 ;