Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC14.m

    r613 r623  
    1 SCAPMC14        ;ALB/REW - Team API's: PTPR ; JUN 30, 1995
    2         ;;5.3;Scheduling;**41,520**;AUG 13, 1993;Build 26
    3         ;;1.0
    4 PTPR(SC200,SCDATES,SCPURPA,SCROLEA,SCLIST,SCERR,SCYESCL)        ; -- list patients for a pract (scyescl NOT supported)
    5         ; input:
    6         ; SC200 = ien of NEW PERSON file(#200) [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         ;  SCROLEA-array of pointer to 403.46 (per SCPURPA)
    19         ;  SCLIST -array name to store list
    20         ;          [ex. ^TMP("SCPT",$J)]
    21         ;       
    22         ;  SCERR = array NAME to store error messages.
    23         ;          [ex. ^TMP("ORXX",$J)]
    24         ;  SCYESCL = Boolean to indicate 1=use associated clinics 0=don't
    25         ;            default=0
    26         ;
    27         ;
    28         ; Output:
    29         ;  SCLIST() = array of patients
    30         ;             Format:
    31         ;               Subscript: Sequential # from 1 to n
    32         ;               Piece     Description
    33         ;                 1       IEN of PATIENT file entry
    34         ;                 2       Name of patient
    35         ;                 3       IEN of Pt Team Posit Asment if position=source
    36         ;                 4       Activation Date
    37         ;                 5       Inactivation Date
    38         ;                 6       Source 1=Clinic, Null=Position
    39         ;                 7       IEN of Clinic if clinic=source
    40         ;
    41         ;  SCERR() = Array of DIALOG file messages(errors) .
    42         ;  @SCERR@(0) = number of errors, undefined if none
    43         ;             Format:
    44         ;               Subscript: Sequential # from 1 to n
    45         ;               Piece     Description
    46         ;                 1       IEN of DIALOG file
    47         ;  Returned: 1 if ok, 0 if error
    48         ;
    49         ;
    50 ST      N SCTM,SCPTA,SCPTA0,SCOK,SCX,NODE,TPACT,TPINACT,SCTEMP,SCTP,SCUSR
    51         N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
    52         ; -- initialize control variables
    53         G:'$$OKDATA PRACQ
    54         ; -- get list of positions for practitioner
    55         G:'$$TPPR^SCAPMC(SC200,SCDATES,.SCPURPA,.SCROLEA,"SCTEMP",.SCERR) PRACQ
    56         G:'$G(SCTEMP(0)) PRACQ
    57         S SCTP=0
    58         ;get list of patients for each position
    59         F SCX=1:1 S NODE=$G(SCTEMP(SCX)),SCTP=+NODE Q:'SCTP  D  Q:'SCOK
    60         .S TPACT=$P(SCTEMP(SCX),U,5)
    61         .S TPINACT=$P(SCTEMP(SCX),U,6)
    62         .N SCDTPR
    63         .S SCDTPR("BEGIN")=$S(TPACT>@SCDATES@("BEGIN"):TPACT,1:@SCDATES@("BEGIN"))
    64         .S SCDTPR("END")=$S('TPINACT:@SCDATES@("END"),(TPINACT<@SCDATES@("END")):TPINACT,1:@SCDATES@("END"))
    65         .S SCDTPR("INCL")=@SCDATES@("INCL")
    66         .S SCOK=$$PTTP^SCAPMC(SCTP,"SCDTPR",.SCLIST,.SCERR)
    67         .Q:'SCOK
    68         .Q:'SCYESCL
    69         .;S SC44=$P($G(^SCTM(404.57,+SCTP,0)),U,9)
    70         .;Q:'SC44
    71         .N CNAME,SC44
    72         .D SETASCL^SCRPRAC2(SCTP,.CNAME,.SC44)
    73         .N SCCNT S SCCNT=0
    74         .F  S SCCNT=$O(SC44(SCCNT)) Q:SCCNT=""  S SCOK=$$PTCL^SCAPMC(SC44(SCCNT),"SCDTPR",.SCLIST,.SCERR)
    75 PRACQ   Q $G(@SCERR@(0))<1
    76         ;
    77 OKDATA()        ;setup/check variables
    78         N SCOK
    79         S SCOK=1
    80         S SCYESCL=$G(SCYESCL,0)
    81         D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
    82         IF '$D(^VA(200,+$G(SC200),0)) D  S SCOK=0
    83         . S SCPARM("PRACT")=$G(SC200,"Undefined")
    84         . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
    85         ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
    86         IF '$D(^VA(200,+SC200,0)) D   S SCOK=0
    87         . S SCPARM("PRACT")=SC200
    88         . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
    89         Q SCOK
    90         ;
     1SCAPMC14 ;ALB/REW - Team API's: PTPR ; JUN 30, 1995
     2 ;;5.3;Scheduling;**41**;AUG 13, 1993
     3 ;;1.0
     4PTPR(SC200,SCDATES,SCPURPA,SCROLEA,SCLIST,SCERR,SCYESCL) ; -- list patients for a pract (scyescl NOT supported)
     5 ; input:
     6 ; SC200 = ien of NEW PERSON file(#200) [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 ;  SCROLEA-array of pointer to 403.46 (per SCPURPA)
     19 ;  SCLIST -array name to store list
     20 ;          [ex. ^TMP("SCPT",$J)]
     21 ;       
     22 ;  SCERR = array NAME to store error messages.
     23 ;          [ex. ^TMP("ORXX",$J)]
     24 ;  SCYESCL = Boolean to indicate 1=use associated clinics 0=don't
     25 ;            default=0
     26 ;
     27 ;
     28 ; Output:
     29 ;  SCLIST() = array of patients
     30 ;             Format:
     31 ;               Subscript: Sequential # from 1 to n
     32 ;               Piece     Description
     33 ;                 1       IEN of PATIENT file entry
     34 ;                 2       Name of patient
     35 ;                 3       IEN of Pt Team Posit Asment if position=source
     36 ;                 4       Activation Date
     37 ;                 5       Inactivation Date
     38 ;                 6       Source 1=Clinic, Null=Position
     39 ;                 7       IEN of Clinic if clinic=source
     40 ;
     41 ;  SCERR() = Array of DIALOG file messages(errors) .
     42 ;  @SCERR@(0) = number of errors, undefined if none
     43 ;             Format:
     44 ;               Subscript: Sequential # from 1 to n
     45 ;               Piece     Description
     46 ;                 1       IEN of DIALOG file
     47 ;  Returned: 1 if ok, 0 if error
     48 ;
     49 ;
     50ST N SCTM,SCPTA,SCPTA0,SCOK,SCX,NODE,TPACT,TPINACT,SCTEMP,SCTP,SCUSR
     51 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
     52 ; -- initialize control variables
     53 G:'$$OKDATA PRACQ
     54 ; -- get list of positions for practitioner
     55 G:'$$TPPR^SCAPMC(SC200,SCDATES,.SCPURPA,.SCROLEA,"SCTEMP",.SCERR) PRACQ
     56 G:'$G(SCTEMP(0)) PRACQ
     57 S SCTP=0
     58 ;get list of patients for each position
     59 F SCX=1:1 S NODE=$G(SCTEMP(SCX)),SCTP=+NODE Q:'SCTP  D  Q:'SCOK
     60 .S TPACT=$P(SCTEMP(SCX),U,5)
     61 .S TPINACT=$P(SCTEMP(SCX),U,6)
     62 .N SCDTPR
     63 .S SCDTPR("BEGIN")=$S(TPACT>@SCDATES@("BEGIN"):TPACT,1:@SCDATES@("BEGIN"))
     64 .S SCDTPR("END")=$S('TPINACT:@SCDATES@("END"),(TPINACT<@SCDATES@("END")):TPINACT,1:@SCDATES@("END"))
     65 .S SCDTPR("INCL")=@SCDATES@("INCL")
     66 .S SCOK=$$PTTP^SCAPMC(SCTP,"SCDTPR",.SCLIST,.SCERR)
     67 .Q:'SCOK
     68 .Q:'SCYESCL
     69 .S SC44=$P($G(^SCTM(404.57,+SCTP,0)),U,9)
     70 .Q:'SC44
     71 .S SCOK=$$PTCL^SCAPMC(SC44,"SCDTPR",.SCLIST,.SCERR)
     72PRACQ Q $G(@SCERR@(0))<1
     73 ;
     74OKDATA() ;setup/check variables
     75 N SCOK
     76 S SCOK=1
     77 S SCYESCL=$G(SCYESCL,0)
     78 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
     79 IF '$D(^VA(200,+$G(SC200),0)) D  S SCOK=0
     80 . S SCPARM("PRACT")=$G(SC200,"Undefined")
     81 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
     82 ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
     83 IF '$D(^VA(200,+SC200,0)) D   S SCOK=0
     84 . S SCPARM("PRACT")=SC200
     85 . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
     86 Q SCOK
     87 ;
Note: See TracChangeset for help on using the changeset viewer.