- 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 Feb 19, 2025@00:04:24 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)