SCAPMC14.m

SCAPMC14 ;ALB/REW - Team API's: PTPR ; JUN 30, 1995

 ;;5.3;Scheduling;**41,520,1015**;AUG 13, 1993;Build 21

 ;;1.0

PTPR(SC200,SCDATES,SCPURPA,SCROLEA,SCLIST,SCERR,SCYESCL) ; -- list patients for a pract (scyescl NOT supported)

 ; input:

 ; SC200 = ien of NEW PERSON file(#200) [required]

 ;  SCDATES("BEGIN") = begin date to search (inclusive)

 ;                       [default: TODAY]

 ;        ("END")   = end date to search (inclusive)

 ;                      [default: TODAY]

 ;        ("INCL")  = 1: only use patients who were assigned to

 ;                       team for entire date range

 ;                    0: anytime in date range

 ;                      [default: 1] 

 ;  SCPURPA -array of pointers to team purpose file 403.47

 ;          if none are defined - returns all teams

 ;          if @SCPURPA@('exclude') is defined - exclude listed teams

 ;  SCROLEA-array of pointer to 403.46 (per SCPURPA)

 ;  SCLIST -array name to store list

 ;          [ex. ^TMP("SCPT",$J)]

 ;        

 ;  SCERR = array NAME to store error messages.

 ;          [ex. ^TMP("ORXX",$J)]

 ;  SCYESCL = Boolean to indicate 1=use associated clinics 0=don't

 ;            default=0

 ;

 ;

 ; Output:

 ;  SCLIST() = array of patients

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of PATIENT file entry

 ;                 2       Name of patient

 ;                 3       IEN of Pt Team Posit Asment if position=source

 ;                 4       Activation Date

 ;                 5       Inactivation Date

 ;                 6       Source 1=Clinic, Null=Position

 ;                 7       IEN of Clinic if clinic=source

 ;

 ;  SCERR() = Array of DIALOG file messages(errors) .

 ;  @SCERR@(0) = number of errors, undefined if none

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of DIALOG file

 ;  Returned: 1 if ok, 0 if error

 ;

 ;

ST N SCTM,SCPTA,SCPTA0,SCOK,SCX,NODE,TPACT,TPINACT,SCTEMP,SCTP,SCUSR

 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS

 ; -- initialize control variables

 G:'$$OKDATA PRACQ

 ; -- get list of positions for practitioner

 G:'$$TPPR^SCAPMC(SC200,SCDATES,.SCPURPA,.SCROLEA,"SCTEMP",.SCERR) PRACQ

 G:'$G(SCTEMP(0)) PRACQ

 S SCTP=0

 ;get list of patients for each position

 F SCX=1:1 S NODE=$G(SCTEMP(SCX)),SCTP=+NODE Q:'SCTP  D  Q:'SCOK

 .S TPACT=$P(SCTEMP(SCX),U,5)

 .S TPINACT=$P(SCTEMP(SCX),U,6)

 .N SCDTPR

 .S SCDTPR("BEGIN")=$S(TPACT>@SCDATES@("BEGIN"):TPACT,1:@SCDATES@("BEGIN"))

 .S SCDTPR("END")=$S('TPINACT:@SCDATES@("END"),(TPINACT<@SCDATES@("END")):TPINACT,1:@SCDATES@("END"))

 .S SCDTPR("INCL")=@SCDATES@("INCL")

 .S SCOK=$$PTTP^SCAPMC(SCTP,"SCDTPR",.SCLIST,.SCERR)

 .Q:'SCOK

 .Q:'SCYESCL

 .;S SC44=$P($G(^SCTM(404.57,+SCTP,0)),U,9)

 .;Q:'SC44

 .N CNAME,SC44

 .D SETASCL^SCRPRAC2(SCTP,.CNAME,.SC44)

 .N SCCNT S SCCNT=0

 .F  S SCCNT=$O(SC44(SCCNT)) Q:SCCNT=""  S SCOK=$$PTCL^SCAPMC(SC44(SCCNT),"SCDTPR",.SCLIST,.SCERR)

PRACQ Q $G(@SCERR@(0))<1

 ;

OKDATA() ;setup/check variables

 N SCOK

 S SCOK=1

 S SCYESCL=$G(SCYESCL,0)

 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)

 IF '$D(^VA(200,+$G(SC200),0)) D  S SCOK=0

 . S SCPARM("PRACT")=$G(SC200,"Undefined")

 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)

 ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)

 IF '$D(^VA(200,+SC200,0)) D   S SCOK=0

 . S SCPARM("PRACT")=SC200

 . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)

 Q SCOK

 ;

SCAPMC14  ;ALB/REW - Team API's: PTPR ; JUN 30, 1995

 +1       ;;5.3;Scheduling;**41,520,1015**;AUG 13, 1993;Build 21

 +2       ;;1.0

PTPR(SC200,SCDATES,SCPURPA,SCROLEA,SCLIST,SCERR,SCYESCL) ; -- list patients for a pract (scyescl NOT supported)

 +1       ; input:

 +2       ; SC200 = ien of NEW PERSON file(#200) [required]

 +3       ;  SCDATES("BEGIN") = begin date to search (inclusive)

 +4       ;                       [default: TODAY]

 +5       ;        ("END")   = end date to search (inclusive)

 +6       ;                      [default: TODAY]

 +7       ;        ("INCL")  = 1: only use patients who were assigned to

 +8       ;                       team for entire date range

 +9       ;                    0: anytime in date range

 +10      ;                      [default: 1] 

 +11      ;  SCPURPA -array of pointers to team purpose file 403.47

 +12      ;          if none are defined - returns all teams

 +13      ;          if @SCPURPA@('exclude') is defined - exclude listed teams

 +14      ;  SCROLEA-array of pointer to 403.46 (per SCPURPA)

 +15      ;  SCLIST -array name to store list

 +16      ;          [ex. ^TMP("SCPT",$J)]

 +17      ;        

 +18      ;  SCERR = array NAME to store error messages.

 +19      ;          [ex. ^TMP("ORXX",$J)]

 +20      ;  SCYESCL = Boolean to indicate 1=use associated clinics 0=don't

 +21      ;            default=0

 +22      ;

 +23      ;

 +24      ; Output:

 +25      ;  SCLIST() = array of patients

 +26      ;             Format:

 +27      ;               Subscript: Sequential # from 1 to n

 +28      ;               Piece     Description

 +29      ;                 1       IEN of PATIENT file entry

 +30      ;                 2       Name of patient

 +31      ;                 3       IEN of Pt Team Posit Asment if position=source

 +32      ;                 4       Activation Date

 +33      ;                 5       Inactivation Date

 +34      ;                 6       Source 1=Clinic, Null=Position

 +35      ;                 7       IEN of Clinic if clinic=source

 +36      ;

 +37      ;  SCERR() = Array of DIALOG file messages(errors) .

 +38      ;  @SCERR@(0) = number of errors, undefined if none

 +39      ;             Format:

 +40      ;               Subscript: Sequential # from 1 to n

 +41      ;               Piece     Description

 +42      ;                 1       IEN of DIALOG file

 +43      ;  Returned: 1 if ok, 0 if error

 +44      ;

 +45      ;

ST         NEW SCTM,SCPTA,SCPTA0,SCOK,SCX,NODE,TPACT,TPINACT,SCTEMP,SCTP,SCUSR

 +1        NEW SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS

 +2       ; -- initialize control variables

 +3        IF '$$OKDATA

               GOTO PRACQ

 +4       ; -- get list of positions for practitioner

 +5        IF '$$TPPR^SCAPMC(SC200,SCDATES,.SCPURPA,.SCROLEA,"SCTEMP",.SCERR)

               GOTO PRACQ

 +6        IF '$GET(SCTEMP(0))

               GOTO PRACQ

 +7        SET SCTP=0

 +8       ;get list of patients for each position

 +9        FOR SCX=1:1

               SET NODE=$GET(SCTEMP(SCX))

               SET SCTP=+NODE

               IF 'SCTP

                   QUIT 

               Begin DoDot:1

 +10               SET TPACT=$PIECE(SCTEMP(SCX),U,5)

 +11               SET TPINACT=$PIECE(SCTEMP(SCX),U,6)

 +12               NEW SCDTPR

 +13               SET SCDTPR("BEGIN")=$SELECT(TPACT>@SCDATES@("BEGIN"):TPACT,1:@SCDATES@("BEGIN"))

 +14               SET SCDTPR("END")=$SELECT('TPINACT:@SCDATES@("END"),(TPINACT<@SCDATES@("END")):TPINACT,1:@SCDATES@("END"))

 +15               SET SCDTPR("INCL")=@SCDATES@("INCL")

 +16               SET SCOK=$$PTTP^SCAPMC(SCTP,"SCDTPR",.SCLIST,.SCERR)

 +17               IF 'SCOK

                       QUIT 

 +18               IF 'SCYESCL

                       QUIT 

 +19      ;S SC44=$P($G(^SCTM(404.57,+SCTP,0)),U,9)

 +20      ;Q:'SC44

 +21               NEW CNAME,SC44

 +22               DO SETASCL^SCRPRAC2(SCTP,.CNAME,.SC44)

 +23               NEW SCCNT

                   SET SCCNT=0

 +24               FOR 

                       SET SCCNT=$ORDER(SC44(SCCNT))

                       IF SCCNT=""

                           QUIT 

                       SET SCOK=$$PTCL^SCAPMC(SC44(SCCNT),"SCDTPR",.SCLIST,.SCERR)

               End DoDot:1

               IF 'SCOK

                   QUIT 

PRACQ      QUIT $GET(@SCERR@(0))<1

 +1       ;

OKDATA()  ;setup/check variables

 +1        NEW SCOK

 +2        SET SCOK=1

 +3        SET SCYESCL=$GET(SCYESCL,0)

 +4       ; set default dates & error array (if undefined)

           DO INIT^SCAPMCU1(.SCOK)

 +5        IF '$DATA(^VA(200,+$GET(SC200),0))

               Begin DoDot:1

 +6                SET SCPARM("PRACT")=$GET(SC200,"Undefined")

 +7                DO ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)

               End DoDot:1

               SET SCOK=0

 +8       ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)

 +9        IF '$DATA(^VA(200,+SC200,0))

               Begin DoDot:1

 +10               SET SCPARM("PRACT")=SC200

 +11               DO ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)

               End DoDot:1

               SET SCOK=0

 +12       QUIT SCOK

 +13      ;