| 1 | SCAPMC3 ;ALB/REW - Team API's:TMPT ; 6/3/99 3:18pm
|
|---|
| 2 | ;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
|
|---|
| 3 | ;;1.0
|
|---|
| 4 | TMPT(DFN,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for a patient
|
|---|
| 5 | ; input:
|
|---|
| 6 | ; DFN = ien of PATIENT file [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 | ; SCPURPA -array of pointers to team purpose file 403.47
|
|---|
| 16 | ; if none are defined - returns all teams
|
|---|
| 17 | ; if @SCPURPA@('exclude') is defined - exclude listed teams
|
|---|
| 18 | ; SCLIST -array name to store list
|
|---|
| 19 | ; [ex. ^TMP("SCPT",$J)]
|
|---|
| 20 | ;
|
|---|
| 21 | ; SCERR = array NAME to store error messages.
|
|---|
| 22 | ; [ex. ^TMP("ORXX",$J)]
|
|---|
| 23 | ;
|
|---|
| 24 | ; Output:
|
|---|
| 25 | ; SCLIST() = array of teams (includes SCTM xref)
|
|---|
| 26 | ; Format:
|
|---|
| 27 | ; Subscript: Sequential # from 1 to n
|
|---|
| 28 | ; Piece Description
|
|---|
| 29 | ; 1 IEN of TEAM file entry
|
|---|
| 30 | ; 2 Name of team
|
|---|
| 31 | ; 3 IEN of file #404.42 (Pt Tm Assignment)
|
|---|
| 32 | ; 4 current effective date
|
|---|
| 33 | ; 5 current inactivate date (if any)
|
|---|
| 34 | ; 6 pointer to 403.47 (purpose)
|
|---|
| 35 | ; 7 Name of Purpose
|
|---|
| 36 | ; 8 Is this the pt's PC Team?
|
|---|
| 37 | ; Subscript: "SCTM",SCTM,IEN =""
|
|---|
| 38 | ;
|
|---|
| 39 | ; SCERR() = Array of DIALOG file messages(errors) .
|
|---|
| 40 | ; @SCERR@(0) = number of errors, undefined if none
|
|---|
| 41 | ; Format:
|
|---|
| 42 | ; Subscript: Sequential # from 1 to n
|
|---|
| 43 | ; Piece Description
|
|---|
| 44 | ; 1 IEN of DIALOG file
|
|---|
| 45 | ; Returned: 1 if ok, 0 if error
|
|---|
| 46 | ;
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | ST N SCTM,SCPTA,SCPTA0,SCP,SCTMPT
|
|---|
| 50 | N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
|
|---|
| 51 | ; -- initialize control variables
|
|---|
| 52 | G:'$$OKDATA PRACQ
|
|---|
| 53 | ; -- loop through patient team assignments
|
|---|
| 54 | S SCTM=0
|
|---|
| 55 | F S SCTM=$O(^SCPT(404.42,"APTTM",DFN,SCTM)) Q:'SCTM D
|
|---|
| 56 | .Q:1>$$ACTHIST^SCAPMCU2(404.58,SCTM,SCDATES,.SCERR,"SCTMPT")
|
|---|
| 57 | .S SCP=$P(^SCTM(404.51,SCTM,0),U,3)
|
|---|
| 58 | .Q:'$$OKARRAY^SCAPU1(SCPURPA,SCP)
|
|---|
| 59 | .S SCPTA=0
|
|---|
| 60 | .F S SCPTA=$O(^SCPT(404.42,"APTTM",DFN,SCTM,SCPTA)) Q:'SCPTA D
|
|---|
| 61 | ..S SCPTA0=$G(^SCPT(404.42,SCPTA,0))
|
|---|
| 62 | ..Q:'SCPTA0
|
|---|
| 63 | ..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P(SCPTA0,U,2),$P(SCPTA0,U,9))
|
|---|
| 64 | ..D BLD(.SCLIST,SCPTA,SCPTA0)
|
|---|
| 65 | PRACQ Q $G(@SCERR@(0))<1
|
|---|
| 66 | ;
|
|---|
| 67 | ;
|
|---|
| 68 | BLD(SCLIST,SCPTA,SCPTA0) ; -- build list of patient's teams
|
|---|
| 69 | ;
|
|---|
| 70 | ; SCLIST - output array
|
|---|
| 71 | ; SCPTA - ien of pt team assignment
|
|---|
| 72 | ; SCPTA0 - 0 node of pt team assignment file
|
|---|
| 73 | ;
|
|---|
| 74 | ; this builds the array:
|
|---|
| 75 | ; 1 2 3 4 5 6 7 8
|
|---|
| 76 | ; sclist(1->n)=sctm^tmname^scpta^effdt^inactdt^p403.47^purpname^pctm?
|
|---|
| 77 | ;
|
|---|
| 78 | ; for each scpta zero node passed to it
|
|---|
| 79 | ; AND a xref sclist('sctm',sctm,scpta,scn)=""
|
|---|
| 80 | N SCEFFDT,SCCNT,SCTM,SCN,SCTMNODE,SCP,SCPC
|
|---|
| 81 | S SCTM=$P(SCPTA0,U,3)
|
|---|
| 82 | Q:$D(@SCLIST@("SCTM",SCTM,SCPTA))
|
|---|
| 83 | S SCN=$G(@SCLIST@(0),0)+1
|
|---|
| 84 | S @SCLIST@(0)=SCN
|
|---|
| 85 | S SCTMNODE=$G(^SCTM(404.51,SCTM,0)),SCP=$P(SCTMNODE,U,3)
|
|---|
| 86 | ;is assignment type=1?
|
|---|
| 87 | S SCPC=$P(SCPTA0,U,8)=1
|
|---|
| 88 | S @SCLIST@(SCN)=SCTM_U_$P(SCTMNODE,U,1)_U_SCPTA_U_$P(SCPTA0,U,2)_U_$P(SCPTA0,U,9)_U_SCP_U_$S(SCP:$P($G(^SC(403.47,SCP,0)),U,1),1:SCP)_U_SCPC
|
|---|
| 89 | S @SCLIST@("SCTM",SCTM,SCPTA,SCN)=""
|
|---|
| 90 | Q
|
|---|
| 91 | OKDATA() ;setup/check variables
|
|---|
| 92 | N SCOK
|
|---|
| 93 | S SCOK=1
|
|---|
| 94 | S SCPURPA=$G(SCPURPA,"")
|
|---|
| 95 | D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
|
|---|
| 96 | IF $L($G(SCPURPA))&($G(SCPURPA)'?1A1.7AN) D S SCOK=0
|
|---|
| 97 | . S SCPARM("PURPOSE")=$G(SCPURPA,"Undefined")
|
|---|
| 98 | . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
|
|---|
| 99 | IF '$D(^DPT(+$G(DFN),0)) D S SCOK=0
|
|---|
| 100 | . S SCPARM("PATIENT")=$G(PATIENT,"Undefined")
|
|---|
| 101 | . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
|
|---|
| 102 | ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
|
|---|
| 103 | IF '$D(^DPT(+DFN,0)) D S SCOK=0
|
|---|
| 104 | . S SCPARM("PATIENT")=DFN
|
|---|
| 105 | . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
|
|---|
| 106 | Q SCOK
|
|---|
| 107 | ;
|
|---|
