SCAPMC22.m

SCAPMC22 ;ALB/REW - Team API's ; December 1, 1995

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

 ;;1.0

INPTTP(DFN,SCPTTPA,SCINACT,SCERR) ;inactivate patient from a position (pt tm pos assgn - #404.43

 ; input:

 ;  DFN     = pointer to PATIENT file (#2)

 ;  SCPTTPA   = pointer to pt team assign file (#404.43)

 ;  SCINACT = date to inactivate [default=DT]

 ;  SCERR = array NAME to store error messages.

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

 ;

 ; Output:

 ;  SCOK    = 1 if inactivation entry made to file 404.43, 0 ow

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

 ;             Foramt:

 ;  @SCERR@(0)=Number of erros, undefined if none

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of DIALOG file

 N SCTP,SC,SCPARM,SCESEQ,SCLSEQ,SCOK,SCND

 S SCOK=0

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

 S SCND=$G(^SCPT(404.43,SCPTTPA,0))

 G:SCINACT<$P(SCND,U,3) APTTPQ

 S SCTP=+$P(SCND,U,2)

 IF '$$PTTPACT(DFN,SCTP,SCINACT,.SCERR) D  G APTTPQ

 .S SCOK=0

 .S SCPARM("INACTIVE DATE")=SCINACT

 .S SCPARM("MESSAGE")="Patient not assigned to position on date"

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

 ELSE  D

 .S SCOK=1

 .S SC($J,404.43,SCPTTPA_",",.04)=SCINACT

 .S SC($J,404.43,SCPTTPA_",",.08)=$G(DUZ,.5)

 .D NOW^%DTC

 .S SC($J,404.43,SCPTTPA_",",.09)=%

 .D UPDATE^DIE("","SC($J)","SCIEN",.SCERR)

 .I $D(@SCERR@("DIERR")) S SCOK=0

APTTPQ Q SCOK

 ;

PTTPACT(DFN,SCTP,SCDT,SCERR) ;is patient assigned to a position on a given date-time?

 N SCPTDTS,SCTPLST,SCOK,SCTM

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

 S SCOK=0

 S (SCPTDTS("BEGIN"),SCPTDTS("END"))=SCDT

 IF $$TPPT^SCAPMC23(DFN,"SCPTDTS",,,,,0,"SCTPLST",.SCERR) S:$D(SCTPLST("SCTP",SCTM,SCTP)) SCOK=1

 Q SCOK

 ;

OKDATA() ;check/setup variables - return 1 if ok/0 if error

 N SCOK

 S SCOK=1

 D INIT^SCAPMCU1(.SCOK)

 IF '$D(^DPT(DFN,0))!('$D(^SCPT(404.43,SCPTTPA,0))) D  S SCOK=0

 . S SCPARM("PATIENT")=$G(DFN,"Undefined")

 . S SCPARM("Pt POSITION Asnt")=$G(SCPTTPA,"Undefined")

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

 S:'$G(SCACT) SCACT=DT

 S:'$G(SCINACT) SCINACT=DT

 Q SCOK

 ;

INPTSCTP(DFN,SCTP,SCINACT,SCERR) ;inactivate patient from a position - using last pt position assignment - Note: This uses pointer to 404.57 (position) not 404.43 as input

 ; input:

 ;  DFN     = pointer to PATIENT file (#2)

 ;  SCTP    = pointer to POSITION file (#404.57)

 ;  SCINACT = date to inactivate [default=DT]

 ;  SCERR = array NAME to store error messages.

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

 ;

 ; Output:

 ;  SCOK    = 1 if inactivation entry made to file 404.42, 0 ow

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

 ;             Foramt:

 ;  @SCERR@(0)=Number of erros, undefined if none

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of DIALOG file

 ;

 N SCACT

 S SCACT=+$O(^SCPT(404.43,"ADFN",DFN,SCTP,""),-1)

 S SCPTTP=+$O(^SCPT(404.43,"ADFN",DFN,SCTP,SCACT,0))

 Q $$INPTTP(.DFN,.SCPTTP,.SCINACT,.SCERR)

SCAPMC22  ;ALB/REW - Team API's ; December 1, 1995

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

 +2       ;;1.0

INPTTP(DFN,SCPTTPA,SCINACT,SCERR) ;inactivate patient from a position (pt tm pos assgn - #404.43

 +1       ; input:

 +2       ;  DFN     = pointer to PATIENT file (#2)

 +3       ;  SCPTTPA   = pointer to pt team assign file (#404.43)

 +4       ;  SCINACT = date to inactivate [default=DT]

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

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

 +7       ;

 +8       ; Output:

 +9       ;  SCOK    = 1 if inactivation entry made to file 404.43, 0 ow

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

 +11      ;             Foramt:

 +12      ;  @SCERR@(0)=Number of erros, undefined if none

 +13      ;               Subscript: Sequential # from 1 to n

 +14      ;               Piece     Description

 +15      ;                 1       IEN of DIALOG file

 +16       NEW SCTP,SC,SCPARM,SCESEQ,SCLSEQ,SCOK,SCND

 +17       SET SCOK=0

 +18      ;setup/check variables

           IF '$$OKDATA

               GOTO APTTPQ

 +19       SET SCND=$GET(^SCPT(404.43,SCPTTPA,0))

 +20       IF SCINACT<$PIECE(SCND,U,3)

               GOTO APTTPQ

 +21       SET SCTP=+$PIECE(SCND,U,2)

 +22       IF '$$PTTPACT(DFN,SCTP,SCINACT,.SCERR)

               Begin DoDot:1

 +23               SET SCOK=0

 +24               SET SCPARM("INACTIVE DATE")=SCINACT

 +25               SET SCPARM("MESSAGE")="Patient not assigned to position on date"

 +26               DO ERR^SCAPMCU1(SCESEQ,4044201,.SCPARM,"",.SCERR)

               End DoDot:1

               GOTO APTTPQ

 +27      IF '$TEST

               Begin DoDot:1

 +28               SET SCOK=1

 +29               SET SC($JOB,404.43,SCPTTPA_",",.04)=SCINACT

 +30               SET SC($JOB,404.43,SCPTTPA_",",.08)=$GET(DUZ,.5)

 +31               DO NOW^%DTC

 +32               SET SC($JOB,404.43,SCPTTPA_",",.09)=%

 +33               DO UPDATE^DIE("","SC($J)","SCIEN",.SCERR)

 +34               IF $DATA(@SCERR@("DIERR"))

                       SET SCOK=0

               End DoDot:1

APTTPQ     QUIT SCOK

 +1       ;

PTTPACT(DFN,SCTP,SCDT,SCERR) ;is patient assigned to a position on a given date-time?

 +1        NEW SCPTDTS,SCTPLST,SCOK,SCTM

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

 +3        SET SCOK=0

 +4        SET (SCPTDTS("BEGIN"),SCPTDTS("END"))=SCDT

 +5        IF $$TPPT^SCAPMC23(DFN,"SCPTDTS",,,,,0,"SCTPLST",.SCERR)

               IF $DATA(SCTPLST("SCTP",SCTM,SCTP))

                   SET SCOK=1

 +6        QUIT SCOK

 +7       ;

OKDATA()  ;check/setup variables - return 1 if ok/0 if error

 +1        NEW SCOK

 +2        SET SCOK=1

 +3        DO INIT^SCAPMCU1(.SCOK)

 +4        IF '$DATA(^DPT(DFN,0))!('$DATA(^SCPT(404.43,SCPTTPA,0)))

               Begin DoDot:1

 +5                SET SCPARM("PATIENT")=$GET(DFN,"Undefined")

 +6                SET SCPARM("Pt POSITION Asnt")=$GET(SCPTTPA,"Undefined")

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

               End DoDot:1

               SET SCOK=0

 +8        IF '$GET(SCACT)

               SET SCACT=DT

 +9        IF '$GET(SCINACT)

               SET SCINACT=DT

 +10       QUIT SCOK

 +11      ;

INPTSCTP(DFN,SCTP,SCINACT,SCERR) ;inactivate patient from a position - using last pt position assignment - Note: This uses pointer to 404.57 (position) not 404.43 as input

 +1       ; input:

 +2       ;  DFN     = pointer to PATIENT file (#2)

 +3       ;  SCTP    = pointer to POSITION file (#404.57)

 +4       ;  SCINACT = date to inactivate [default=DT]

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

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

 +7       ;

 +8       ; Output:

 +9       ;  SCOK    = 1 if inactivation entry made to file 404.42, 0 ow

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

 +11      ;             Foramt:

 +12      ;  @SCERR@(0)=Number of erros, undefined if none

 +13      ;               Subscript: Sequential # from 1 to n

 +14      ;               Piece     Description

 +15      ;                 1       IEN of DIALOG file

 +16      ;

 +17       NEW SCACT

 +18       SET SCACT=+$ORDER(^SCPT(404.43,"ADFN",DFN,SCTP,""),-1)

 +19       SET SCPTTP=+$ORDER(^SCPT(404.43,"ADFN",DFN,SCTP,SCACT,0))

 +20       QUIT $$INPTTP(.DFN,.SCPTTP,.SCINACT,.SCERR)