- SCAPMC7 ;ALB/REW - Team APIs:INPTTM ; 5 Jul 1995
- ;;5.3;Scheduling;**41,148**;AUG 13, 1993
- ;;1.0
- INPTTM(DFN,SCPTTM,SCINACT,SCERR) ;inactivate patient from a team (pt tm assgn - #404.42
- ; input:
- ; DFN = pointer to PATIENT file (#2)
- ; SCPTTM = pointer to pt team assign file (#404.42)
- ; 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 SCTM,SC,SCPARM,SCESEQ,SCLSEQ,SCOK
- S SCOK=0
- G:'$$OKDATA APTTMQ ;setup/check variables
- S SCTM=+$P($G(^SCPT(404.42,SCPTTM,0)),U,3)
- IF '$$PTTMACT(DFN,SCTM,SCINACT,.SCERR) D G APTTMQ
- .S SCOK=0
- .S SCPARM("INACTIVE DATE")=SCINACT
- .D ERR^SCAPMCU1(SCESEQ,4044201,.SCPARM,"",.SCERR)
- ELSE D
- .S SCOK=1
- .S SC($J,404.42,SCPTTM_",",.09)=SCINACT
- .S SC($J,404.42,SCPTTM_",",.13)=$G(DUZ,.5)
- .D NOW^%DTC
- .S SC($J,404.42,SCPTTM_",",.14)=%
- .D UPDATE^DIE("","SC($J)","SCIEN",.SCERR)
- .I $D(@SCERR@("DIERR")) S SCOK=0
- APTTMQ Q SCOK
- ;
- PTTMACT(DFN,SCTM,SCDT,SCERR) ;is patient assigned to a team on a given date-time?
- N SCTMDTS,SCTMLST,SCOK
- S SCOK=0
- S (SCTMDTS("BEGIN"),SCTMDTS("END"))=SCDT
- IF $$TMPT^SCAPMC3(DFN,"SCTMDTS","","SCTMLST",.SCERR) S:$D(SCTMLST("SCTM",SCTM)) 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.42,SCPTTM,0))) D S SCOK=0
- . S SCPARM("PATIENT")=$G(DFN,"Undefined")
- . S SCPARM("Pt TEAM Asnt")=$G(SCPTTM,"Undefined")
- . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
- S:'$G(SCACT) SCACT=DT
- S:'$G(SCINACT) SCINACT=DT
- Q SCOK
- ;
- INPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
- ; input: as per ACPTTM (above with the following change:)
- ; DFNA = is the literal value of a patient array (e.g. "scpt"
- ; there is at least one scpt(dfn)="" defined
- ; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
- ; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
- ; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
- ; Note: The above three arrays return data in a user determined array
- ; output: Count of Patients:
- ; 1 2 3 4
- ; total assigned^newly assigned^assigned prior^not assigned
- N DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCX
- S (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
- S DFN=0 F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
- .S SCPTTM=$$HISTPTTM^SCAPMCU2(DFN,.SCTM,.SCACT)
- .S SCX=$S(SCPTTM:$$INPTTM(.DFN,.SCPTTM,.SCFIELDA,.SCACT,.SCERR),1:0)
- .; SCX = ien of 404.42^new?
- .IF $P(SCX,U,2) D ;newly assigned
- ..S SCNEWCNT=SCNEWCNT+1
- ..S @SCNEWTM@(DFN)=+SCX ;scnewtm
- .IF $P(SCX,U,1)&('$P($G(SCX),U,2)) D ;old
- ..S SCOLDCNT=SCOLDCNT+1
- ..S @SCOLDTM@(DFN)=+SCX
- .IF 'SCX D
- ..S @SCBADTM@(DFN)=""
- ..S SCBADCNT=SCBADCNT+1
- Q (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
- ;
- INPTSCTM(DFN,SCTM,SCINACT,SCERR) ;inactivate patient from a team - using last pt team assignment - Note: This uses pointer to 404.51 (team) not 404.42 as input
- ; input:
- ; DFN = pointer to PATIENT file (#2)
- ; SCTM = pointer to TEAM file (#404.51)
- ; 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.42,"AIDT",DFN,SCTM,""))
- S SCPTTM=+$O(^SCPT(404.42,"AIDT",DFN,SCTM,SCACT,0))
- Q $$INPTTM(.DFN,.SCPTTM,.SCINACT,.SCERR)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC7 4229 printed Feb 19, 2025@00:04:38 Page 2
- SCAPMC7 ;ALB/REW - Team APIs:INPTTM ; 5 Jul 1995
- +1 ;;5.3;Scheduling;**41,148**;AUG 13, 1993
- +2 ;;1.0
- INPTTM(DFN,SCPTTM,SCINACT,SCERR) ;inactivate patient from a team (pt tm assgn - #404.42
- +1 ; input:
- +2 ; DFN = pointer to PATIENT file (#2)
- +3 ; SCPTTM = pointer to pt team assign file (#404.42)
- +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 NEW SCTM,SC,SCPARM,SCESEQ,SCLSEQ,SCOK
- +17 SET SCOK=0
- +18 ;setup/check variables
- if '$$OKDATA
- GOTO APTTMQ
- +19 SET SCTM=+$PIECE($GET(^SCPT(404.42,SCPTTM,0)),U,3)
- +20 IF '$$PTTMACT(DFN,SCTM,SCINACT,.SCERR)
- Begin DoDot:1
- +21 SET SCOK=0
- +22 SET SCPARM("INACTIVE DATE")=SCINACT
- +23 DO ERR^SCAPMCU1(SCESEQ,4044201,.SCPARM,"",.SCERR)
- End DoDot:1
- GOTO APTTMQ
- +24 IF '$TEST
- Begin DoDot:1
- +25 SET SCOK=1
- +26 SET SC($JOB,404.42,SCPTTM_",",.09)=SCINACT
- +27 SET SC($JOB,404.42,SCPTTM_",",.13)=$GET(DUZ,.5)
- +28 DO NOW^%DTC
- +29 SET SC($JOB,404.42,SCPTTM_",",.14)=%
- +30 DO UPDATE^DIE("","SC($J)","SCIEN",.SCERR)
- +31 IF $DATA(@SCERR@("DIERR"))
- SET SCOK=0
- End DoDot:1
- APTTMQ QUIT SCOK
- +1 ;
- PTTMACT(DFN,SCTM,SCDT,SCERR) ;is patient assigned to a team on a given date-time?
- +1 NEW SCTMDTS,SCTMLST,SCOK
- +2 SET SCOK=0
- +3 SET (SCTMDTS("BEGIN"),SCTMDTS("END"))=SCDT
- +4 IF $$TMPT^SCAPMC3(DFN,"SCTMDTS","","SCTMLST",.SCERR)
- if $DATA(SCTMLST("SCTM",SCTM))
- SET SCOK=1
- +5 QUIT SCOK
- 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.42,SCPTTM,0)))
- Begin DoDot:1
- +5 SET SCPARM("PATIENT")=$GET(DFN,"Undefined")
- +6 SET SCPARM("Pt TEAM Asnt")=$GET(SCPTTM,"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 ;
- INPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
- +1 ; input: as per ACPTTM (above with the following change:)
- +2 ; DFNA = is the literal value of a patient array (e.g. "scpt"
- +3 ; there is at least one scpt(dfn)="" defined
- +4 ; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
- +5 ; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
- +6 ; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
- +7 ; Note: The above three arrays return data in a user determined array
- +8 ; output: Count of Patients:
- +9 ; 1 2 3 4
- +10 ; total assigned^newly assigned^assigned prior^not assigned
- +11 NEW DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCX
- +12 SET (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
- +13 SET DFN=0
- FOR
- SET DFN=$ORDER(@DFNA@(DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +14 SET SCPTTM=$$HISTPTTM^SCAPMCU2(DFN,.SCTM,.SCACT)
- +15 SET SCX=$SELECT(SCPTTM:$$INPTTM(.DFN,.SCPTTM,.SCFIELDA,.SCACT,.SCERR),1:0)
- +16 ; SCX = ien of 404.42^new?
- +17 ;newly assigned
- IF $PIECE(SCX,U,2)
- Begin DoDot:2
- +18 SET SCNEWCNT=SCNEWCNT+1
- +19 ;scnewtm
- SET @SCNEWTM@(DFN)=+SCX
- End DoDot:2
- +20 ;old
- IF $PIECE(SCX,U,1)&('$PIECE($GET(SCX),U,2))
- Begin DoDot:2
- +21 SET SCOLDCNT=SCOLDCNT+1
- +22 SET @SCOLDTM@(DFN)=+SCX
- End DoDot:2
- +23 IF 'SCX
- Begin DoDot:2
- +24 SET @SCBADTM@(DFN)=""
- +25 SET SCBADCNT=SCBADCNT+1
- End DoDot:2
- End DoDot:1
- +26 QUIT (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
- +27 ;
- INPTSCTM(DFN,SCTM,SCINACT,SCERR) ;inactivate patient from a team - using last pt team assignment - Note: This uses pointer to 404.51 (team) not 404.42 as input
- +1 ; input:
- +2 ; DFN = pointer to PATIENT file (#2)
- +3 ; SCTM = pointer to TEAM file (#404.51)
- +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.42,"AIDT",DFN,SCTM,""))
- +19 SET SCPTTM=+$ORDER(^SCPT(404.42,"AIDT",DFN,SCTM,SCACT,0))
- +20 QUIT $$INPTTM(.DFN,.SCPTTM,.SCINACT,.SCERR)