| [613] | 1 | SCAPMC18 ;ALB/REW - Team APIs:ACPTCL ; 5 Jul 1995
 | 
|---|
 | 2 |  ;;5.3;Scheduling;**41,45,50,130,148**;AUG 13, 1993
 | 
|---|
 | 3 |  ;;1.0
 | 
|---|
 | 4 | ACPTCL(DFN,SCCL,SCFIELDA,SCACT,SCERR) ;add a patient to a clinic (enrollment)
 | 
|---|
 | 5 |  ; input:
 | 
|---|
 | 6 |  ;  DFN     = pointer to PATIENT file (#2)
 | 
|---|
 | 7 |  ;  SCCL    = pointer to HOSPITAL LOCATION file (#44)
 | 
|---|
 | 8 |  ;  SCFIELDA= array of additional fields to be added
 | 
|---|
 | 9 |  ;  SCACT   = date to activate [default=DT]
 | 
|---|
 | 10 |  ;  SCERR = array NAME to store error messages.
 | 
|---|
 | 11 |  ;          [ex. ^TMP("ORXX",$J)]
 | 
|---|
 | 12 |  ;
 | 
|---|
 | 13 |  ; Output:
 | 
|---|
 | 14 |  ;  Returned = ien of enrollment multiple - 0 if none after^new?
 | 
|---|
 | 15 |  ;  SCERR() = Array of DIALOG file messages(errors).
 | 
|---|
 | 16 |  ;             Foramt:
 | 
|---|
 | 17 |  ;               Subscript: Sequential # from 1 to n
 | 
|---|
 | 18 |  ;               Piece     Description
 | 
|---|
 | 19 |  ;                 1       IEN of DIALOG file
 | 
|---|
 | 20 |  N SCPTCL,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWCL,DIC,X,SCX,DLAYGO
 | 
|---|
 | 21 |  G:'$$OKDATA APTCLQ ;check/setup variables
 | 
|---|
 | 22 |  S SCPTCL=$$PTCLACT(DFN,SCCL,SCACT,.SCERR)
 | 
|---|
 | 23 |  IF SCPTCL G APTCLQ
 | 
|---|
 | 24 |  ELSE  D
 | 
|---|
 | 25 |  .D BEFORE^SCMCEV3(DFN)  ;invoke clinic enrollment event driver
 | 
|---|
 | 26 |  .S DIC="^DPT("_DFN_",""DE"","
 | 
|---|
 | 27 |  .S SCX=DIC_"0)"
 | 
|---|
 | 28 |  .L +@(SCX):5
 | 
|---|
 | 29 |  .IF '$T D:'$G(DGQUIET) EN^DDIOL("Enrollment being edited") Q
 | 
|---|
 | 30 |  .S DIC(0)="L"
 | 
|---|
 | 31 |  .S DIC("P")="2.001P"
 | 
|---|
 | 32 |  .S DA(1)=DFN
 | 
|---|
 | 33 |  .S X=SCCL
 | 
|---|
 | 34 |  .S DLAYGO=2
 | 
|---|
 | 35 |  .D FILE^DICN
 | 
|---|
 | 36 |  .IF (Y'>0) L -@(SCX)
 | 
|---|
 | 37 |  .S DIC=DIC_+Y_",1,"
 | 
|---|
 | 38 |  .S DIC("P")="2.011D"
 | 
|---|
 | 39 |  .S DA(1)=+Y
 | 
|---|
 | 40 |  .S DA(2)=DFN
 | 
|---|
 | 41 |  .S X=SCACT
 | 
|---|
 | 42 |  .IF $D(SCFIELDA) D
 | 
|---|
 | 43 |  ..K DIC("DR")
 | 
|---|
 | 44 |  ..S SCFLD=0
 | 
|---|
 | 45 |  ..F  S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD  D
 | 
|---|
 | 46 |  ...S:'$D(DIC("DR")) DIC("DR")=SCFLD_"////"_@SCFIELDA@(SCFLD)
 | 
|---|
 | 47 |  ...S:$D(DIC("DR")) DIC("DR")=DIC("DR")_";"_SCFLD_"////"_@SCFIELDA@(SCFLD)
 | 
|---|
 | 48 |  .D FILE^DICN
 | 
|---|
 | 49 |  .S SCPTCL=$P(Y,U,2)
 | 
|---|
 | 50 |  .S SCNEWCL=$P(Y,U,3)
 | 
|---|
 | 51 |  .L -@(SCX)
 | 
|---|
 | 52 |  .D AFTER^SCMCEV3(DFN),INVOKE^SCMCEV3(DFN)
 | 
|---|
 | 53 | APTCLQ Q +$G(SCPTCL)_U_+$G(SCNEWCL)
 | 
|---|
 | 54 |  ;
 | 
|---|
 | 55 | PTCLACT(DFN,SCCL,SCDT,SCERR) ;what is patient/clinic enrollment date on a given date-time? Return date or 0
 | 
|---|
 | 56 |  N SCDATES,SCCLLST,SCOK,SCDATES
 | 
|---|
 | 57 |  S SCOK=0
 | 
|---|
 | 58 |  S (SCDATES("BEGIN"),SCDATES("END"))=SCDT
 | 
|---|
 | 59 |  IF $$CLPT^SCAPMC(DFN,"SCDATES","","SCCLLST",.SCERR) S:$D(SCCLLST("SCCL",SCCL)) SCOK=$O(SCCLLST("SCCL",SCCL,0))
 | 
|---|
 | 60 |  Q SCOK
 | 
|---|
 | 61 |  ;
 | 
|---|
 | 62 | OKDATA() ;setup/check variables
 | 
|---|
 | 63 |  N SCOK
 | 
|---|
 | 64 |  S SCOK=1
 | 
|---|
 | 65 |  D INIT^SCAPMCU1(.SCOK)
 | 
|---|
 | 66 |  IF +$G(SCCL)'=$G(SCCL) D  S SCOK=0
 | 
|---|
 | 67 |  . S SCPARM("CLINIC")=$G(SCCL,"Undefined")
 | 
|---|
 | 68 |  . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
 | 
|---|
 | 69 |  IF '$D(^SC(+$G(SCCL),0)) D  S SCOK=0
 | 
|---|
 | 70 |  . S SCPARM("CLINIC")=$G(SCCL,"Undefined")
 | 
|---|
 | 71 |  . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
 | 
|---|
 | 72 |  IF '$D(^DPT(DFN,0)) D  S SCOK=0
 | 
|---|
 | 73 |  . S SCPARM("PATIENT")=DFN
 | 
|---|
 | 74 |  . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
 | 
|---|
 | 75 |  S:'$G(SCACT) SCACT=DT
 | 
|---|
 | 76 |  Q SCOK
 | 
|---|