[613] | 1 | SCAPMC23 ;ALB/REW - Team API's:TPPT ; JUN 30, 1995
|
---|
| 2 | ;;5.3;Scheduling;**41,148**;AUG 13, 1993
|
---|
| 3 | ;;1.0
|
---|
| 4 | TPPT(DFN,SCDATES,SCPOSA,SCUSRA,SCPURPA,SCROLEA,SCYESCL,SCLIST,SCERR) ; -- positions for a patient
|
---|
| 5 | ; input:
|
---|
| 6 | ; DFN = ien of PATIENT file(#2) [required]
|
---|
| 7 | ; SCDATES("BEGIN") = begin date to search (inclusive)
|
---|
| 8 | ; [default: TODAY]
|
---|
| 9 | ; ("END") = end date to search (inclusive)
|
---|
| 10 | ; [default: TODAY]
|
---|
| 11 | ; ("INCL") = 1: only use patients who were assigned to
|
---|
| 12 | ; team for entire date range
|
---|
| 13 | ; 0: anytime in date range
|
---|
| 14 | ; [default: 1]
|
---|
| 15 | ; SCPOSA -array of pointers to team position - 404.57 (per SCPURPA)
|
---|
| 16 | ; SCUSRA -array of pointers to user file - 8930 (per SCPURPA array)
|
---|
| 17 | ; SCPURPA -array of pointers to team purpose file 403.47
|
---|
| 18 | ; if none are defined - returns all teams
|
---|
| 19 | ; if @SCPURPA@('exclude') is defined - exclude listed teams
|
---|
| 20 | ; SCROLEA - array of pointers to std position file 403.46 (per SCPURPA)
|
---|
| 21 | ; SCYESCL -boolean[0-NO(default)/1-YES] Include pts asc. via enrollment?
|
---|
| 22 | ; SCLIST -array name to store list
|
---|
| 23 | ; [ex. ^TMP("SCPT",$J)]
|
---|
| 24 | ;
|
---|
| 25 | ; SCERR = array NAME to store error messages.
|
---|
| 26 | ; [ex. ^TMP("ORXX",$J)]
|
---|
| 27 | ;
|
---|
| 28 | ; Output:
|
---|
| 29 | ; SCLIST() = array of positions (includes SCTP xref)
|
---|
| 30 | ; Format:
|
---|
| 31 | ; Subscript: Sequential # from 1 to n
|
---|
| 32 | ; Piece Description
|
---|
| 33 | ; 1 IEN of TEAM POSITION File (#404.57)
|
---|
| 34 | ; 2 Name of Position
|
---|
| 35 | ; 3 IEN of Team #404.51
|
---|
| 36 | ; 4 IEN of file #404.43 (Pt Tm Pos Assign -404.43)
|
---|
| 37 | ; 5 current effective date
|
---|
| 38 | ; 6 current inactivate date (if any)
|
---|
| 39 | ; 7 pointer to 403.46 (role)
|
---|
| 40 | ; 8 Name of Standard Role
|
---|
| 41 | ; 9 pointer to User Class (#8930)
|
---|
| 42 | ; 10 Name of User Class
|
---|
| 43 | ; 11 Pointer to patient team assignment (404.42)JLU
|
---|
| 44 | ; Subscript: "SCTP",SCTM,IEN =""
|
---|
| 45 | ;
|
---|
| 46 | ; SCERR() = Array of DIALOG file messages(errors) .
|
---|
| 47 | ; @SCERR@(0) = number of errors, undefined if none
|
---|
| 48 | ; Format:
|
---|
| 49 | ; Subscript: Sequential # from 1 to n
|
---|
| 50 | ; Piece Description
|
---|
| 51 | ; 1 IEN of DIALOG file
|
---|
| 52 | ; Returned: 1 if ok, 0 if error
|
---|
| 53 | ; Other:
|
---|
| 54 | ; SCACTHIS = status (-1:err|0:inact|1:act)^404.59 ien ^actdt^inacdt
|
---|
| 55 | ;
|
---|
| 56 | ;
|
---|
| 57 | ST N SCPTTP,SCPTTP0,SCTP,SCR,SCACTHIS,SCTM,SCND,SCU,SCPTTPI,SCTPA,SCPTBEG,SCPTEND,SCTPPT,SCTEAMA,SCENROLL
|
---|
| 58 | N SCLSEQ,SCN,SCESEQ,SCPARM,SCBEGIN,SCEND,SCINCL,SCDTS,SCPTPA
|
---|
| 59 | ; -- initialize control variables
|
---|
| 60 | G:'$$OKDATA PRACQ
|
---|
| 61 | ; -- loop through patient team position assignment history
|
---|
| 62 | S (SCTP,SCTPA)=0
|
---|
| 63 | F S SCTP=$O(^SCPT(404.43,"ADFN",DFN,SCTP)) Q:'SCTP D
|
---|
| 64 | .F SCPTTP=0:0 S SCPTTP=$O(^SCPT(404.43,"ADFN",DFN,SCTP,SCPTTP)) Q:'SCPTTP D
|
---|
| 65 | .. ; S SCPTTPI=$O(^SCPT(404.43,"ADFN",DFN,SCTP,SCPTTP,0))
|
---|
| 66 | .. ; replaced line above with FOR LOOP and new dot level below. Now loops thru all assignments
|
---|
| 67 | .. ; made on a given day - PDR 9/98
|
---|
| 68 | .. S SCPTPA="" ; position assignment IEN
|
---|
| 69 | .. F S SCPTPA=$O(^SCPT(404.43,"ADFN",DFN,SCTP,SCPTTP,SCPTPA)) Q:'SCPTPA D
|
---|
| 70 | ... S SCPTTP0=$G(^SCPT(404.43,SCPTPA,0))
|
---|
| 71 | ... S SCPTBEG=$P(SCPTTP0,U,3)
|
---|
| 72 | ... S SCPTEND=$P(SCPTTP0,U,4)
|
---|
| 73 | ... Q:1>$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCPTBEG,SCPTEND)
|
---|
| 74 | ... S SCACTHIS=$$ACTHIST^SCAPMCU2(404.59,SCTP,SCDATES,SCERR,"SCTPPT")
|
---|
| 75 | ... ; --- below changes scacthis to send 404.43 data
|
---|
| 76 | ... S:SCPTBEG>$P(SCACTHIS,U,3) $P(SCACTHIS,U,3)=SCPTBEG
|
---|
| 77 | ... S:SCPTEND&((SCPTEND<$P(SCACTHIS,U,4))!('$P(SCACTHIS,U,4))) $P(SCACTHIS,U,4)=SCPTEND
|
---|
| 78 | ... S $P(SCACTHIS,U,2)=SCPTPA ; SCPTTPI
|
---|
| 79 | ... Q:'SCACTHIS
|
---|
| 80 | ... Q:'$$OKARRAY^SCAPU1(.SCPOSA,.SCTP)
|
---|
| 81 | ... S SCND=$G(^SCTM(404.57,SCTP,0)) ;the team position 0 node
|
---|
| 82 | ... S SCU=$P(SCND,U,13)
|
---|
| 83 | ... Q:'$$OKUSRCL^SCAPU1(.SCUSRA,.SCU)
|
---|
| 84 | ... S SCTM=$P(SCND,U,2)
|
---|
| 85 | ... S SCP=$P(^SCTM(404.51,+SCTM,0),U,3)
|
---|
| 86 | ... Q:'$$OKARRAY^SCAPU1(.SCPURPA,.SCP)
|
---|
| 87 | ... S SCPTA=0
|
---|
| 88 | ... S SCR=+$P(SCND,U,3)
|
---|
| 89 | ... Q:'$$OKARRAY^SCAPU1(.SCROLEA,.SCR)
|
---|
| 90 | ... D BLD^SCAPMC24(.SCLIST,SCTM,SCTP,SCACTHIS,SCR)
|
---|
| 91 | ; - if scyescl=1 get enrolled clinics & find positions associated w clinc for teams that the pt is in
|
---|
| 92 | G:'SCYESCL PRACQ
|
---|
| 93 | IF '$$TMPT^SCAPMC(DFN,SCDATES,.SCPURPA,"SCTEAMA",.SCERR) G PRACQ
|
---|
| 94 | IF '$$CLPT^SCAPMC29(DFN,SCDATES,"SCTEAMA","SCENROLL",.SCERR) G PRACQ
|
---|
| 95 | IF '$G(SCENROLL(0)) G PRACQ
|
---|
| 96 | S INDX=0
|
---|
| 97 | F INDX=1:1:$G(SCENROLL(0)) S SCX=$G(SCENROLL(INDX)) D
|
---|
| 98 | .IF 'SCX D Q
|
---|
| 99 | ..S SCPARM("Enroll Xref")=$G(SCX)
|
---|
| 100 | ..D ERR^SCAPMCU1(.SCESEQ,,SCPARM,"",.SCERR)
|
---|
| 101 | .S SC44=$P(SCX,U,1)
|
---|
| 102 | .S ENR("BEGIN")=$S(SCBEGIN>$P(SCX,U,3):SCBEGIN,1:$P(SCX,U,3))
|
---|
| 103 | .S ENR("END")=$S('$P(SCX,U,4):SCEND,(SCEND<$P(SCX,U,4)):SCEND,1:$P(SCX,U,4))
|
---|
| 104 | .S ENR("INCL")=SCINCL
|
---|
| 105 | .Q:'$$TPCL^SCAPMC(SC44,"ENR",.SCPOSA,.SCUSRA,.SCPURPA,.SCROLEA,.SCLIST,.SCERR)
|
---|
| 106 | PRACQ Q $G(@SCERR@(0))<1
|
---|
| 107 | ;
|
---|
| 108 | OKDATA() ;setup/check variables
|
---|
| 109 | N SCOK
|
---|
| 110 | S SCOK=1
|
---|
| 111 | D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
|
---|
| 112 | S SCYESCL=+$G(SCYESCL,0)
|
---|
| 113 | IF '$D(^DPT(+$G(DFN),0)) D S SCOK=0
|
---|
| 114 | . S SCPARM("Patient")=$G(DFN,"Undefined")
|
---|
| 115 | . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
|
---|
| 116 | ;
|
---|
| 117 | Q SCOK
|
---|
| 118 | ;
|
---|