SCAPMC11.m

SCAPMC11 ;ALB/REW - Team API's: PTTP ; JUN 30, 1995

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

 ;IHS/ANMC/LJF 12/06/2000 changed SSN with HRCN in long pat ID

 ;

 ;;1.0

PTTP(SCTP,SCDATES,SCLIST,SCERR) ; -- list of patient team position assignments

 ; input:

 ;  SCTP = ien of TEAM POSITION [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

 ;                       position for entire date range

 ;                    0: anytime in date range

 ;                      [default: 1] 

 ;  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 patients

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of PATIENT file entry

 ;                 2       Name of patient

 ;                 3       IEN of Patient Team Position Assignment

 ;                 4       Activation Date

 ;                 5       Inactivation Date

 ;                 6       Patient's Long ID - (SSN)

 ;

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

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

 ;             Foramt:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of DIALOG file

 ;

 ;   Returned: 1 if ok, 0 if error

 ;

 ;

ST N SCTPA,SCPTA,SCPTA0,SCPTMA,SCPTPA,SCPTPA0

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

 G:'$$OKDATA PRACQ ;check/setup variables

 ; -- loop through patient team position assignments

LP S SCPTMA=0

 F  S SCPTMA=$O(^SCPT(404.43,"APTPA",SCTP,SCPTMA)) Q:'SCPTMA  D

 .S SCPTPA=0

 .F  S SCPTPA=$O(^SCPT(404.43,"APTPA",SCTP,SCPTMA,SCPTPA)) Q:'SCPTPA  D

 ..S SCPTPA0=$G(^SCPT(404.43,SCPTPA,0))

 ..Q:'SCPTPA0

 ..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P(SCPTPA0,U,3),$P(SCPTPA0,U,4))

 ..D BLD(.SCLIST,SCPTPA,SCPTPA0)

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

 ;

 ;

BLD(SCLIST,SCPTTPA,SCPTTPA0) ; build list

 ; SCPTTPA    - ien of patient team position assignment file #404.43

 ; SCEFFDT - negative of effective date

 ; SCN     - current subscript (counter) 1->n

 ; SCPTTPA0 - IS 0 node of Pt Team Pos Assnt(404.43) 1st piece:pt tm ass

 ; 

 ; this builds the array:

 ;   sclist(1->n)=sc2^ptname^effdt^inactdt

 ;    for each scpta zero node passed to it

 Q:'SCPTTPA!('SCPTTPA0)  ;add error trapping?

 Q:$D(@SCLIST@("SCPTTPA",+SCPTTPA0,SCPTTPA))

 N SCEFFDT,SCCNT,DFN

 S DFN=+$G(^SCPT(404.42,+SCPTTPA0,0))

 Q:$D(^TMP("SCMC",$J,"EXCLUDE PT","SCPTA",+DFN))

 S SCN=$G(@SCLIST@(0),0)+1

 S @SCLIST@(0)=SCN

 ;S @SCLIST@(SCN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)_U_SCPTTPA_U_$P(SCPTTPA0,U,3)_U_$P(SCPTTPA0,U,4)_U_$P($G(^DPT(DFN,.36)),U,3)  ;IHS/ANMC/LJF 12/06/2000

 S @SCLIST@(SCN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)_U_SCPTTPA_U_$P(SCPTTPA0,U,3)_U_$P(SCPTTPA0,U,4)_U_$$HRCN^BDGF2(DFN,+$G(DUZ(2)))   ;IHS/ANMC/LJF 12/06/2000

 S @SCLIST@("SCPTTPA",+SCPTTPA0,SCPTTPA,SCN)=""

 S @SCLIST@("SCPTA",DFN,SCN)=""

 Q

OKDATA() ;check/setup variables

 N SCOK

 S SCOK=1

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

 IF '$D(^SCTM(404.57,+$G(SCTP),0)) D  S SCOK=0

 . S SCPARM("POSITION")=$G(SCTP,"Undefined")

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

 ; -- is it a valid TEAM ien passed (Error # 4045701 in DIALOG file)

 IF '$D(^SCTM(404.57,+SCTP,0)) D  S SCOK=0

 . S SCPARM("TEAM")=SCTP

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

 Q SCOK

SCAPMC11  ;ALB/REW - Team API's: PTTP ; JUN 30, 1995

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

 +2       ;IHS/ANMC/LJF 12/06/2000 changed SSN with HRCN in long pat ID

 +3       ;

 +4       ;;1.0

PTTP(SCTP,SCDATES,SCLIST,SCERR) ; -- list of patient team position assignments

 +1       ; input:

 +2       ;  SCTP = ien of TEAM POSITION [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       ;                       position for entire date range

 +9       ;                    0: anytime in date range

 +10      ;                      [default: 1] 

 +11      ;  SCLIST -array name to store list

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

 +13      ;        

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

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

 +16      ;

 +17      ; Output:

 +18      ;  SCLIST() = array of patients

 +19      ;             Format:

 +20      ;               Subscript: Sequential # from 1 to n

 +21      ;               Piece     Description

 +22      ;                 1       IEN of PATIENT file entry

 +23      ;                 2       Name of patient

 +24      ;                 3       IEN of Patient Team Position Assignment

 +25      ;                 4       Activation Date

 +26      ;                 5       Inactivation Date

 +27      ;                 6       Patient's Long ID - (SSN)

 +28      ;

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

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

 +31      ;             Foramt:

 +32      ;               Subscript: Sequential # from 1 to n

 +33      ;               Piece     Description

 +34      ;                 1       IEN of DIALOG file

 +35      ;

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

 +37      ;

 +38      ;

ST         NEW SCTPA,SCPTA,SCPTA0,SCPTMA,SCPTPA,SCPTPA0

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

 +2       ;check/setup variables

           IF '$$OKDATA

               GOTO PRACQ

 +3       ; -- loop through patient team position assignments

LP         SET SCPTMA=0

 +1        FOR 

               SET SCPTMA=$ORDER(^SCPT(404.43,"APTPA",SCTP,SCPTMA))

               IF 'SCPTMA

                   QUIT 

               Begin DoDot:1

 +2                SET SCPTPA=0

 +3                FOR 

                       SET SCPTPA=$ORDER(^SCPT(404.43,"APTPA",SCTP,SCPTMA,SCPTPA))

                       IF 'SCPTPA

                           QUIT 

                       Begin DoDot:2

 +4                        SET SCPTPA0=$GET(^SCPT(404.43,SCPTPA,0))

 +5                        IF 'SCPTPA0

                               QUIT 

 +6                        IF '$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$PIECE(SCPTPA0,U,3),$PIECE(SCPTPA0,U,4))

                               QUIT 

 +7                        DO BLD(.SCLIST,SCPTPA,SCPTPA0)

                       End DoDot:2

               End DoDot:1

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

 +1       ;

 +2       ;

BLD(SCLIST,SCPTTPA,SCPTTPA0) ; build list

 +1       ; SCPTTPA    - ien of patient team position assignment file #404.43

 +2       ; SCEFFDT - negative of effective date

 +3       ; SCN     - current subscript (counter) 1->n

 +4       ; SCPTTPA0 - IS 0 node of Pt Team Pos Assnt(404.43) 1st piece:pt tm ass

 +5       ; 

 +6       ; this builds the array:

 +7       ;   sclist(1->n)=sc2^ptname^effdt^inactdt

 +8       ;    for each scpta zero node passed to it

 +9       ;add error trapping?

           IF 'SCPTTPA!('SCPTTPA0)

               QUIT 

 +10       IF $DATA(@SCLIST@("SCPTTPA",+SCPTTPA0,SCPTTPA))

               QUIT 

 +11       NEW SCEFFDT,SCCNT,DFN

 +12       SET DFN=+$GET(^SCPT(404.42,+SCPTTPA0,0))

 +13       IF $DATA(^TMP("SCMC",$JOB,"EXCLUDE PT","SCPTA",+DFN))

               QUIT 

 +14       SET SCN=$GET(@SCLIST@(0),0)+1

 +15       SET @SCLIST@(0)=SCN

 +16      ;S @SCLIST@(SCN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)_U_SCPTTPA_U_$P(SCPTTPA0,U,3)_U_$P(SCPTTPA0,U,4)_U_$P($G(^DPT(DFN,.36)),U,3)  ;IHS/ANMC/LJF 12/06/2000

 +17      ;IHS/ANMC/LJF 12/06/2000

           SET @SCLIST@(SCN)=DFN_U_$PIECE($GET(^DPT(DFN,0)),U,1)_U_SCPTTPA_U_$PIECE(SCPTTPA0,U,3)_U_$PIECE(SCPTTPA0,U,4)_U_$$HRCN^BDGF2(DFN,+$GET(DUZ(2)))

 +18       SET @SCLIST@("SCPTTPA",+SCPTTPA0,SCPTTPA,SCN)=""

 +19       SET @SCLIST@("SCPTA",DFN,SCN)=""

 +20       QUIT 

OKDATA()  ;check/setup variables

 +1        NEW SCOK

 +2        SET SCOK=1

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

           DO INIT^SCAPMCU1(.SCOK)

 +4        IF '$DATA(^SCTM(404.57,+$GET(SCTP),0))

               Begin DoDot:1

 +5                SET SCPARM("POSITION")=$GET(SCTP,"Undefined")

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

               End DoDot:1

               SET SCOK=0

 +7       ; -- is it a valid TEAM ien passed (Error # 4045701 in DIALOG file)

 +8        IF '$DATA(^SCTM(404.57,+SCTP,0))

               Begin DoDot:1

 +9                SET SCPARM("TEAM")=SCTP

 +10               DO ERR^SCAPMCU1(SCESEQ,4045701,.SCPARM,"",.SCERR)

               End DoDot:1

               SET SCOK=0

 +11       QUIT SCOK