SCAPMC18 ;ALB/REW - Team APIs:ACPTCL ; 5 Jul 1995
;;5.3;Scheduling;**41,45,50,130,148**;AUG 13, 1993
;;1.0
ACPTCL(DFN,SCCL,SCFIELDA,SCACT,SCERR) ;add a patient to a clinic (enrollment)
; input:
; DFN = pointer to PATIENT file (#2)
; SCCL = pointer to HOSPITAL LOCATION file (#44)
; SCFIELDA= array of additional fields to be added
; SCACT = date to activate [default=DT]
; SCERR = array NAME to store error messages.
; [ex. ^TMP("ORXX",$J)]
;
; Output:
; Returned = ien of enrollment multiple - 0 if none after^new?
; SCERR() = Array of DIALOG file messages(errors).
; Foramt:
; Subscript: Sequential # from 1 to n
; Piece Description
; 1 IEN of DIALOG file
N SCPTCL,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWCL,DIC,X,SCX,DLAYGO
G:'$$OKDATA APTCLQ ;check/setup variables
S SCPTCL=$$PTCLACT(DFN,SCCL,SCACT,.SCERR)
IF SCPTCL G APTCLQ
ELSE D
.D BEFORE^SCMCEV3(DFN) ;invoke clinic enrollment event driver
.S DIC="^DPT("_DFN_",""DE"","
.S SCX=DIC_"0)"
.L +@(SCX):5
.IF '$T D:'$G(DGQUIET) EN^DDIOL("Enrollment being edited") Q
.S DIC(0)="L"
.S DIC("P")="2.001P"
.S DA(1)=DFN
.S X=SCCL
.S DLAYGO=2
.D FILE^DICN
.IF (Y'>0) L -@(SCX)
.S DIC=DIC_+Y_",1,"
.S DIC("P")="2.011D"
.S DA(1)=+Y
.S DA(2)=DFN
.S X=SCACT
.IF $D(SCFIELDA) D
..K DIC("DR")
..S SCFLD=0
..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
...S:'$D(DIC("DR")) DIC("DR")=SCFLD_"////"_@SCFIELDA@(SCFLD)
...S:$D(DIC("DR")) DIC("DR")=DIC("DR")_";"_SCFLD_"////"_@SCFIELDA@(SCFLD)
.D FILE^DICN
.S SCPTCL=$P(Y,U,2)
.S SCNEWCL=$P(Y,U,3)
.L -@(SCX)
.D AFTER^SCMCEV3(DFN),INVOKE^SCMCEV3(DFN)
APTCLQ Q +$G(SCPTCL)_U_+$G(SCNEWCL)
;
PTCLACT(DFN,SCCL,SCDT,SCERR) ;what is patient/clinic enrollment date on a given date-time? Return date or 0
N SCDATES,SCCLLST,SCOK,SCDATES
S SCOK=0
S (SCDATES("BEGIN"),SCDATES("END"))=SCDT
IF $$CLPT^SCAPMC(DFN,"SCDATES","","SCCLLST",.SCERR) S:$D(SCCLLST("SCCL",SCCL)) SCOK=$O(SCCLLST("SCCL",SCCL,0))
Q SCOK
;
OKDATA() ;setup/check variables
N SCOK
S SCOK=1
D INIT^SCAPMCU1(.SCOK)
IF +$G(SCCL)'=$G(SCCL) D S SCOK=0
. S SCPARM("CLINIC")=$G(SCCL,"Undefined")
. D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
IF '$D(^SC(+$G(SCCL),0)) D S SCOK=0
. S SCPARM("CLINIC")=$G(SCCL,"Undefined")
. D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
IF '$D(^DPT(DFN,0)) D S SCOK=0
. S SCPARM("PATIENT")=DFN
. D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
S:'$G(SCACT) SCACT=DT
Q SCOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC18 2582 printed Dec 13, 2024@02:37:52 Page 2
SCAPMC18 ;ALB/REW - Team APIs:ACPTCL ; 5 Jul 1995
+1 ;;5.3;Scheduling;**41,45,50,130,148**;AUG 13, 1993
+2 ;;1.0
ACPTCL(DFN,SCCL,SCFIELDA,SCACT,SCERR) ;add a patient to a clinic (enrollment)
+1 ; input:
+2 ; DFN = pointer to PATIENT file (#2)
+3 ; SCCL = pointer to HOSPITAL LOCATION file (#44)
+4 ; SCFIELDA= array of additional fields to be added
+5 ; SCACT = date to activate [default=DT]
+6 ; SCERR = array NAME to store error messages.
+7 ; [ex. ^TMP("ORXX",$J)]
+8 ;
+9 ; Output:
+10 ; Returned = ien of enrollment multiple - 0 if none after^new?
+11 ; SCERR() = Array of DIALOG file messages(errors).
+12 ; Foramt:
+13 ; Subscript: Sequential # from 1 to n
+14 ; Piece Description
+15 ; 1 IEN of DIALOG file
+16 NEW SCPTCL,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWCL,DIC,X,SCX,DLAYGO
+17 ;check/setup variables
if '$$OKDATA
GOTO APTCLQ
+18 SET SCPTCL=$$PTCLACT(DFN,SCCL,SCACT,.SCERR)
+19 IF SCPTCL
GOTO APTCLQ
+20 IF '$TEST
Begin DoDot:1
+21 ;invoke clinic enrollment event driver
DO BEFORE^SCMCEV3(DFN)
+22 SET DIC="^DPT("_DFN_",""DE"","
+23 SET SCX=DIC_"0)"
+24 LOCK +@(SCX):5
+25 IF '$TEST
if '$GET(DGQUIET)
DO EN^DDIOL("Enrollment being edited")
QUIT
+26 SET DIC(0)="L"
+27 SET DIC("P")="2.001P"
+28 SET DA(1)=DFN
+29 SET X=SCCL
+30 SET DLAYGO=2
+31 DO FILE^DICN
+32 IF (Y'>0)
LOCK -@(SCX)
+33 SET DIC=DIC_+Y_",1,"
+34 SET DIC("P")="2.011D"
+35 SET DA(1)=+Y
+36 SET DA(2)=DFN
+37 SET X=SCACT
+38 IF $DATA(SCFIELDA)
Begin DoDot:2
+39 KILL DIC("DR")
+40 SET SCFLD=0
+41 FOR
SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
if 'SCFLD
QUIT
Begin DoDot:3
+42 if '$DATA(DIC("DR"))
SET DIC("DR")=SCFLD_"////"_@SCFIELDA@(SCFLD)
+43 if $DATA(DIC("DR"))
SET DIC("DR")=DIC("DR")_";"_SCFLD_"////"_@SCFIELDA@(SCFLD)
End DoDot:3
End DoDot:2
+44 DO FILE^DICN
+45 SET SCPTCL=$PIECE(Y,U,2)
+46 SET SCNEWCL=$PIECE(Y,U,3)
+47 LOCK -@(SCX)
+48 DO AFTER^SCMCEV3(DFN)
DO INVOKE^SCMCEV3(DFN)
End DoDot:1
APTCLQ QUIT +$GET(SCPTCL)_U_+$GET(SCNEWCL)
+1 ;
PTCLACT(DFN,SCCL,SCDT,SCERR) ;what is patient/clinic enrollment date on a given date-time? Return date or 0
+1 NEW SCDATES,SCCLLST,SCOK,SCDATES
+2 SET SCOK=0
+3 SET (SCDATES("BEGIN"),SCDATES("END"))=SCDT
+4 IF $$CLPT^SCAPMC(DFN,"SCDATES","","SCCLLST",.SCERR)
if $DATA(SCCLLST("SCCL",SCCL))
SET SCOK=$ORDER(SCCLLST("SCCL",SCCL,0))
+5 QUIT SCOK
+6 ;
OKDATA() ;setup/check variables
+1 NEW SCOK
+2 SET SCOK=1
+3 DO INIT^SCAPMCU1(.SCOK)
+4 IF +$GET(SCCL)'=$GET(SCCL)
Begin DoDot:1
+5 SET SCPARM("CLINIC")=$GET(SCCL,"Undefined")
+6 DO ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+7 IF '$DATA(^SC(+$GET(SCCL),0))
Begin DoDot:1
+8 SET SCPARM("CLINIC")=$GET(SCCL,"Undefined")
+9 DO ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+10 IF '$DATA(^DPT(DFN,0))
Begin DoDot:1
+11 SET SCPARM("PATIENT")=DFN
+12 DO ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+13 if '$GET(SCACT)
SET SCACT=DT
+14 QUIT SCOK
