SCAPMC13.m

SCAPMC13 ;ALB/REW - Team API's: TMPR ; JUN 30, 1995 [10/22/98 2:10pm]

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

 ;

TMPR(SC200,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for a pract

 ; 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

 ;  SCLIST -array name to store list

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

 ;        

 ;  SCERR = array NAME to store error messages.

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

 ;

 ; Output:

 ;  SCLIST() = array of teams (includes SCTM xref)

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of TEAM file entry

 ;                 2       Name of team

 ;                 3       IEN of file #404.52 (Pos Assign History)

 ;                 4       current effective date

 ;                 5       current inactivate date (if any)

 ;                 6       pointer to 403.47 (purpose)

 ;                 7       Name of Purpose

 ;                Subscript: "SCTM",SCTM,IEN =""

 ;

 ;  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,SCTP,SCTMPR

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

 ; -- initialize control variables

 G:'$$OKDATA PRACQ

 ; -- loop through position assignments (404.52) for pract

 S SCTPA=0

 F  S SCTPA=$O(^SCTM(404.52,"C",SC200,SCTPA)) Q:'SCTPA  D

 .S SCTP=$P($G(^SCTM(404.52,SCTPA,0)),U,1)

 .Q:'SCTP

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

 .Q:'SCTM

 .;;bp/djb Fix error due to bad pointers in TEAM field of

 .;;       TEAM POSITION file

 .;;new code begin

 .Q:'$D(^SCTM(404.51,SCTM,0))

 .;;new code end

 .S SCP=$P(^SCTM(404.51,SCTM,0),U,3)

 .;;bp/djb Fix error due to calling rtn not initializing SCPURPA in

 .;;       parameter list. Change line to pass SCPURPA by reference.

 .;;changed code begin

 .Q:'$$OKARRAY^SCAPU1(.SCPURPA,SCP)

 .;;changed code end

 .S ACTHIST=$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCTMPR")

 .Q:'ACTHIST

 .D BLDTM^SCAPMC4(SCTM,SCDATES,ACTHIST,.SCLIST,.SCERR)

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

 ;

OKDATA() ;setup/check variables

 N SCOK

 S SCOK=1

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

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

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

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

 Q SCOK

 ;

SCAPMC13  ;ALB/REW - Team API's: TMPR ; JUN 30, 1995 [10/22/98 2:10pm]

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

 +2       ;

TMPR(SC200,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for a pract

 +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      ;  SCLIST -array name to store list

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

 +16      ;        

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

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

 +19      ;

 +20      ; Output:

 +21      ;  SCLIST() = array of teams (includes SCTM xref)

 +22      ;             Format:

 +23      ;               Subscript: Sequential # from 1 to n

 +24      ;               Piece     Description

 +25      ;                 1       IEN of TEAM file entry

 +26      ;                 2       Name of team

 +27      ;                 3       IEN of file #404.52 (Pos Assign History)

 +28      ;                 4       current effective date

 +29      ;                 5       current inactivate date (if any)

 +30      ;                 6       pointer to 403.47 (purpose)

 +31      ;                 7       Name of Purpose

 +32      ;                Subscript: "SCTM",SCTM,IEN =""

 +33      ;

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

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

 +36      ;             Format:

 +37      ;               Subscript: Sequential # from 1 to n

 +38      ;               Piece     Description

 +39      ;                 1       IEN of DIALOG file

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

 +41      ;

 +42      ;

ST         NEW SCTM,SCPTA,SCPTA0,SCTP,SCTMPR

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

 +2       ; -- initialize control variables

 +3        IF '$$OKDATA

               GOTO PRACQ

 +4       ; -- loop through position assignments (404.52) for pract

 +5        SET SCTPA=0

 +6        FOR 

               SET SCTPA=$ORDER(^SCTM(404.52,"C",SC200,SCTPA))

               IF 'SCTPA

                   QUIT 

               Begin DoDot:1

 +7                SET SCTP=$PIECE($GET(^SCTM(404.52,SCTPA,0)),U,1)

 +8                IF 'SCTP

                       QUIT 

 +9                SET SCTM=$PIECE($GET(^SCTM(404.57,+$GET(SCTP),0)),U,2)

 +10               IF 'SCTM

                       QUIT 

 +11      ;;bp/djb Fix error due to bad pointers in TEAM field of

 +12      ;;       TEAM POSITION file

 +13      ;;new code begin

 +14               IF '$DATA(^SCTM(404.51,SCTM,0))

                       QUIT 

 +15      ;;new code end

 +16               SET SCP=$PIECE(^SCTM(404.51,SCTM,0),U,3)

 +17      ;;bp/djb Fix error due to calling rtn not initializing SCPURPA in

 +18      ;;       parameter list. Change line to pass SCPURPA by reference.

 +19      ;;changed code begin

 +20               IF '$$OKARRAY^SCAPU1(.SCPURPA,SCP)

                       QUIT 

 +21      ;;changed code end

 +22               SET ACTHIST=$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCTMPR")

 +23               IF 'ACTHIST

                       QUIT 

 +24               DO BLDTM^SCAPMC4(SCTM,SCDATES,ACTHIST,.SCLIST,.SCERR)

               End DoDot:1

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

 +1       ;

OKDATA()  ;setup/check variables

 +1        NEW SCOK

 +2        SET SCOK=1

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

           DO INIT^SCAPMCU1(.SCOK)

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

               Begin DoDot:1

 +5                SET SCPARM("PRACTITIONER")=$GET(SC200,"Undefined")

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

               End DoDot:1

               SET SCOK=0

 +7        QUIT SCOK

 +8       ;