- 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 Mar 13, 2025@21:42:48 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
