| [613] | 1 | SCAPMC26 ;ALB/REW - API: Patients in a Clinic ; December 1, 1995 [12/21/98 4:30pm]
|
|---|
| 2 | ;;5.3;Scheduling;**41,157**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | PTCL(SC44,SCDATES,SCLIST,SCERR) ; patients in a clinic
|
|---|
| 5 | ; Input:
|
|---|
| 6 | ; SC44 - Pointer to Hospital Location File #44
|
|---|
| 7 | ; SCDATES- Date array (begin, end, incl)
|
|---|
| 8 | ; SCLIST - Name of output array
|
|---|
| 9 | ; SCERR = array NAME to store error messages.
|
|---|
| 10 | ; [ex. ^TMP("ORXX",$J
|
|---|
| 11 | ; Output:
|
|---|
| 12 | ; SCLIST() = array of practitioners (users) - pointers to file #200
|
|---|
| 13 | ; Format:
|
|---|
| 14 | ; Subscript: Sequential # from 1 to n
|
|---|
| 15 | ; Piece Description
|
|---|
| 16 | ; 1 DFN - Ptr to Patient File (#2)
|
|---|
| 17 | ; 2 Patient Name (External)
|
|---|
| 18 | ; 3 null
|
|---|
| 19 | ; 4 Activation Date
|
|---|
| 20 | ; 5 Discharge Date
|
|---|
| 21 | ; 6 '1' - for merge reasons with other pt lists
|
|---|
| 22 | ; 7 sc44
|
|---|
| 23 | ;
|
|---|
| 24 | ; SCERR() = Array of DIALOG file messages(errors) .
|
|---|
| 25 | ; @SCERR(0)= Number of error(s), UNDEFINED if no errors
|
|---|
| 26 | ; Foramt:
|
|---|
| 27 | ; Subscript: Sequential # from 1 to n
|
|---|
| 28 | ; Piece Description
|
|---|
| 29 | ; 1 IEN of DIALOG file
|
|---|
| 30 | ; Returned: 1 if ok, 0 if error
|
|---|
| 31 | ;
|
|---|
| 32 | ST N DFN,SCOK,SCCL,SCCLDT
|
|---|
| 33 | N SCLSEQ,SCN,SCESEQ,SCPARM,SCBEGIN,SCEND,SCINCL,SCDTS
|
|---|
| 34 | ; -- initialize control variables
|
|---|
| 35 | S SCOK=1
|
|---|
| 36 | G:'$$OKDATA CLTPQ
|
|---|
| 37 | ;S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN IF $D(^DPT(DFN,"DE","B",SC44)) S SCCL=$O(^DPT(DFN,"DE","B",SC44,0)) D
|
|---|
| 38 | S SCCLDT=0
|
|---|
| 39 | F S SCCLDT=$O(^DPT("AEB1",SC44,SCCLDT)) Q:'SCCLDT D
|
|---|
| 40 | .S DFN=0
|
|---|
| 41 | .F S DFN=$O(^DPT("AEB1",SC44,SCCLDT,DFN)) Q:'DFN D
|
|---|
| 42 | ..Q:$D(^TMP("SCMC",$J,"EXCLUDE PT","SCPTA",DFN))
|
|---|
| 43 | ..;;bp/cmf 2981008
|
|---|
| 44 | ..;;modified code begin
|
|---|
| 45 | ..S SCCL=$O(^DPT("AEB1",SC44,SCCLDT,DFN,0))
|
|---|
| 46 | ..Q:'SCCL
|
|---|
| 47 | ..S SCX=$O(^DPT("AEB1",SC44,SCCLDT,DFN,SCCL,0))
|
|---|
| 48 | ..Q:'SCX
|
|---|
| 49 | ..S SCNODE=$G(^DPT(DFN,"DE",SCCL,1,SCX,0))
|
|---|
| 50 | ..I $$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P($P(SCNODE,U,1),"."),$P(SCNODE,U,3)) D
|
|---|
| 51 | ...S SCN=$G(@SCLIST@(0),0)+1
|
|---|
| 52 | ...S @SCLIST@(0)=SCN
|
|---|
| 53 | ...S @SCLIST@(SCN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)_U_U_$P(SCNODE,U,1)_U_$P(SCNODE,U,3)_U_"1"_U_SC44_U_$P($G(^DPT(DFN,.36)),U,3)
|
|---|
| 54 | ...Q
|
|---|
| 55 | ..S @SCLIST@("SC PTCL",DFN,SCX,SCN)=""
|
|---|
| 56 | ..Q
|
|---|
| 57 | .Q
|
|---|
| 58 | ;;..modified code end
|
|---|
| 59 | ;;..original code begin
|
|---|
| 60 | ;;..Q:$D(@SCLIST@("SC PTCL",DFN))
|
|---|
| 61 | ;;..S SCCL=0
|
|---|
| 62 | ;;..F S SCCL=$O(^DPT(DFN,"DE","B",SC44,SCCL)) Q:'SCCL D
|
|---|
| 63 | ;;...S SCX=0 F S SCX=$O(^DPT(DFN,"DE",SCCL,1,SCX)) Q:'SCX S SCNODE=^(SCX,0) D
|
|---|
| 64 | ;;....IF $$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P(SCNODE,U,1),$P(SCNODE,U,3)) D
|
|---|
| 65 | ;;.....Q:$D(@SCLIST@("SC PTCL",DFN))
|
|---|
| 66 | ;;.....S SCN=$G(@SCLIST@(0),0)+1
|
|---|
| 67 | ;;.....S @SCLIST@(0)=SCN
|
|---|
| 68 | ;;.....S @SCLIST@(SCN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)_U_U_$P(SCNODE,U,1)_U_$P(SCNODE,U,3)_U_"1"_U_SC44_U_$P($G(^DPT(DFN,.36)),U,3)
|
|---|
| 69 | ;;....S @SCLIST@("SC PTCL",DFN,SCX,SCN)=""
|
|---|
| 70 | ;;original code end
|
|---|
| 71 | ;;bp/cmf 2981008
|
|---|
| 72 | CLTPQ Q $G(@SCERR@(0))<1
|
|---|
| 73 | ;
|
|---|
| 74 | OKDATA() ;check/setup variables - return 1 if ok; 0 if error
|
|---|
| 75 | N SCOK
|
|---|
| 76 | S SCOK=1
|
|---|
| 77 | S (SCN,SCESEQ,SCLSEQ)=0
|
|---|
| 78 | D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
|
|---|
| 79 | IF '$D(^SC(+$G(SC44),0)) D S SCOK=0
|
|---|
| 80 | . S SCPARM("CLINIC")=$G(SC44,"Undefined")
|
|---|
| 81 | . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
|
|---|
| 82 | IF '$L($G(SCLIST)) D S SCOK=0
|
|---|
| 83 | . S SCPARM("OUTPUT ARRAY")=$G(SCLIST,"Undefined")
|
|---|
| 84 | . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
|
|---|
| 85 | Q SCOK
|
|---|
| 86 | ;
|
|---|
| 87 | PTCLBR(SC44,SCTM,SCDATES) ;for PCMM use only!! returns list to ^tmp($j,'scclpt'
|
|---|
| 88 | ; SC44 - Clinic we're adding to team
|
|---|
| 89 | ; SCTM - EXCLUDES Patients assigned to SCTM Team during time period
|
|---|
| 90 | ; SCDATES - Standard Date array
|
|---|
| 91 | ; Returns: $j if successful & at least one entry, 0 if error or none
|
|---|
| 92 | ; Warning: Kills ^tmp($j,'scclpt') before it runs & ^tmp('scmc',$j,'exclude pt') after it runs
|
|---|
| 93 | N SCCLERR,SCX,SCXX
|
|---|
| 94 | K ^TMP($J,"SCCLPT")
|
|---|
| 95 | S SCXX=$$PTTM^SCAPMC(SCTM,.SCDATES,"^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCCLERR")
|
|---|
| 96 | S SCX=$$PTCL(.SC44,.SCDATES,"^TMP($J,""SCCLPT"")","SCCLERR")
|
|---|
| 97 | K ^TMP("SCMC",$J,"EXCLUDE PT")
|
|---|
| 98 | Q $S('SCX:0,('$G(^TMP($J,"SCCLPT",0))):0,1:$J)
|
|---|
| 99 | ;
|
|---|
| 100 | PTCLBRTP(SC44,SCTP,SCDATES) ;for PCMM use only!! returns list to ^tmp($j,'scclpt'
|
|---|
| 101 | ; SC44 - Clinic we're adding to team
|
|---|
| 102 | ; SCTP - EXCLUDES Patients assigned to SCTP Position during scdates
|
|---|
| 103 | ; SCDATES - Standard Date array
|
|---|
| 104 | ; Returns: $j if successful & at least one entry, 0 if error or none
|
|---|
| 105 | ; Warning: Kills ^tmp($j,'scclpt') before it runs
|
|---|
| 106 | N SCCLERR,SCX,SCXX
|
|---|
| 107 | K ^TMP($J,"SCCLPT")
|
|---|
| 108 | S SCXX=$$PTTP^SCAPMC(SCTP,.SCDATES,"^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCCLERR")
|
|---|
| 109 | S SCX=$$PTCL(.SC44,.SCDATES,"^TMP($J,""SCCLPT"")","SCCLERR")
|
|---|
| 110 | K ^TMP("SCMC",$J,"EXCLUDE PT")
|
|---|
| 111 | Q $S('SCX:0,('$G(^TMP($J,"SCCLPT",0))):0,1:$J)
|
|---|
| 112 | ;
|
|---|
