SCAPMC22 ;ALB/REW - Team API's ; December 1, 1995
;;5.3;Scheduling;**41,148**;AUG 13, 1993
;;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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC22 3103 printed Nov 22, 2024@17:47:54 Page 2
SCAPMC22 ;ALB/REW - Team API's ; December 1, 1995
+1 ;;5.3;Scheduling;**41,148**;AUG 13, 1993
+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)
