SCAPMCU4.m

SCAPMCU4 ;ALB/REW - TEAM API UTILITIES ; 30 Mar 96

 ;;5.3;Scheduling;**41**;AUG 13, 1993

 ;;1.0

RESTPT(DFN,SCDATE,SCRPA) ;is pt a restricted consult pt?

 ;   DFN - ien to PATIENT File

 ;   SCATE - Date of interest - default=DT

 ;   SCRPA - literal value of desired restrict patients array

 ;       e.g. scrpa=xx results in xx(sctm)=teamname

 ;   Returned: [1 if yes, 0 if no, -1 if error]

 ; 

 N SCRPDTS,SCOK,SCRPLIST,SCRPERR,SCTM,SCTP,SCYES,SCTMNM,SCNDX,SCND

 S SCYES=0

 S SCRPDTS("BEGIN")=SCDATE

 S SCRPDTS("END")=SCDATE

 S SCRPDTS("INCL")=0

 S SCOK=$$TMPT^SCAPMC(DFN,"SCRPDTS",,"SCRPLIST","SCRPERR")

 IF $G(SCRPLIST(0)) D

 .F SCNDX=1:1:+$G(SCRPLIST(0)) D

 ..S SCND=SCRPLIST(SCNDX)

 ..S SCTM=+SCND

 ..S SCTMNM=$P(SCND,U,2)

 ..S SCPTTM=$P(SCND,U,3)

 ..; restrict from 404.51 (TEAM) file entry??

 ..IF $P($G(^SCTM(404.51,+SCTM,0)),U,13) D

 ...S SCYES=1

 ...S:$L(SCTMNM) @SCRPA@(SCTM)=SCTMNM

 ..; restring from 404.42 (PATIENT TEAM) file entry??

 ..IF $P($G(^SCPT(404.42,+SCPTTM,0)),U,10) D

 ...S SCYES=1

 ...S:$L(SCTMNM) @SCRPA@(SCTM)=SCTMNM

 Q $S($D(SCRPERR):-1,1:SCYES)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCAPMCU4   1103     printed  Apr 09, 2024@21:53:21                                                                                                                                                                                                    Page 2

SCAPMCU4  ;ALB/REW - TEAM API UTILITIES ; 30 Mar 96

 +1       ;;5.3;Scheduling;**41**;AUG 13, 1993

 +2       ;;1.0

RESTPT(DFN,SCDATE,SCRPA) ;is pt a restricted consult pt?

 +1       ;   DFN - ien to PATIENT File

 +2       ;   SCATE - Date of interest - default=DT

 +3       ;   SCRPA - literal value of desired restrict patients array

 +4       ;       e.g. scrpa=xx results in xx(sctm)=teamname

 +5       ;   Returned: [1 if yes, 0 if no, -1 if error]

 +6       ; 

 +7        NEW SCRPDTS,SCOK,SCRPLIST,SCRPERR,SCTM,SCTP,SCYES,SCTMNM,SCNDX,SCND

 +8        SET SCYES=0

 +9        SET SCRPDTS("BEGIN")=SCDATE

 +10       SET SCRPDTS("END")=SCDATE

 +11       SET SCRPDTS("INCL")=0

 +12       SET SCOK=$$TMPT^SCAPMC(DFN,"SCRPDTS",,"SCRPLIST","SCRPERR")

 +13       IF $GET(SCRPLIST(0))

               Begin DoDot:1

 +14               FOR SCNDX=1:1:+$GET(SCRPLIST(0))

                       Begin DoDot:2

 +15                       SET SCND=SCRPLIST(SCNDX)

 +16                       SET SCTM=+SCND

 +17                       SET SCTMNM=$PIECE(SCND,U,2)

 +18                       SET SCPTTM=$PIECE(SCND,U,3)

 +19      ; restrict from 404.51 (TEAM) file entry??

 +20                       IF $PIECE($GET(^SCTM(404.51,+SCTM,0)),U,13)

                               Begin DoDot:3

 +21                               SET SCYES=1

 +22                               if $LENGTH(SCTMNM)

                                       SET @SCRPA@(SCTM)=SCTMNM

                               End DoDot:3

 +23      ; restring from 404.42 (PATIENT TEAM) file entry??

 +24                       IF $PIECE($GET(^SCPT(404.42,+SCPTTM,0)),U,10)

                               Begin DoDot:3

 +25                               SET SCYES=1

 +26                               if $LENGTH(SCTMNM)

                                       SET @SCRPA@(SCTM)=SCTMNM

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +27       QUIT $SELECT($DATA(SCRPERR):-1,1:SCYES)