SDES2CRTAPREQ ;ALB/BWF,JAS,TJB,JAS - CREATE APPOINTMENT REQUEST ; OCT 7, 2024
;;5.3;Scheduling;**869,871,875,877,893**;Aug 13, 1993;Build 6
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$ACTIVPRV^PXAPI is supported by IA #2349
; Reference to $$ACTIVE^XUSER is supported by IA #2343
Q
; RPC: SDES2 CREATE APPT REQ
;
; SDCONTEXT INPUT
;
;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
;
; REQUEST INPUT FORMAT
;
;S REQUEST("DFN")="" REQ (PATIENT IEN)
;S REQUEST("APPOINTMENT TYPE")="" REQ - APPOINTMENT TYPE - can be the Name or IEN
;S REQUEST("PATIENT INDICATED DATE")="" REQ (PID DATE IN ISO FORMAT)
;S REQUEST("PRIORITY")="" REQ
;S REQUEST("REQUEST SUB TYPE")="" REQ
;S REQUEST("REQUESTED BY")="" REQ
;S REQUEST("CLINIC IEN")="" OPT/REQ \
;S REQUEST("PRIMARY AMIS")="" OPT/REQ---> Either CLINIC IEN or PRIMARY AMIS/CREDIT PRIMARY AMIS must be defined
;S REQUEST("CREDIT AMIS")="" OPT/REQ /
;S REQUEST("STATION NUMBER")="" OPT/REQ -- > Either STATION NUMBER or INSTITUTION NAME is REQUIRED
;S REQUEST("INSTITUTION NAME")="" OPT/REQ --/
;S REQUEST("CREATE DATE")="" OPT - Defaults to today if not sent
;S REQUEST("PROVIDER IEN")="" OPT (Required if 'REQUESTED BY' is 'PROVIDER')
;S REQUEST("PRIORITY GROUP")="" OPT
;S REQUEST("SERVICE CONNECTED")="" OPT (This is for PRIORITY; 1 OR 0, if passed)
;S REQUEST("SERVICE CONNECTED PERCENTAGE")="" OPT
;S REQUEST("MODALITY")="" OPT
;S REQUEST("PATIENT STATUS")="" OPT
;S REQUEST("VAOS GUID")="" OPT
;S REQUEST("TIME SENSITIVE")="" OPT
;S REQUEST("REQUEST COMMENT")="" OPT
;S REQUEST("PATIENT COMMENT")="" OPT
;S REQUEST("PATIENT PREFERRED START DATE",1)="" OPT
;S REQUEST("PATIENT PREFERRED END DATE",1)="" OPT
;S REQUEST("PATIENT PREFERRED START DATE",2)="" OPT
;S REQUEST("PATIENT PREFERRED END DATE",2)="" OPT
;S REQUEST("PATIENT PREFERRED START DATE",3)="" OPT
;S REQUEST("PATIENT PREFERRED END DATE",3)="" OPT
;S REQUEST("MRTC","NEEDED")="" OPT (YES/NO)
;S REQUEST("MRTC","PARENT REQUEST")="" OPT
;S REQUEST("MRTC","DAYS BETWEEN APPTS")="" OPT
;S REQUEST("MRTC","HOW MANY NEEDED")="" OPT
;
CREATEREQUEST(JSONRETURN,SDCONTEXT,REQUEST) ;
N REQUESTIEN,ERRORS,RETURN,INSTITUTIONIEN,FILEDATA,ORIGUSER
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
S ORIGUSER=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
;
M FILEDATA=REQUEST
D VALIDATE(.REQUEST,.FILEDATA,.INSTITUTIONIEN,.ERRORS)
;
I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
S REQUESTIEN=$$BUILDER(.FILEDATA,INSTITUTIONIEN,ORIGUSER,$G(SDCONTEXT("ACHERON AUDIT ID")))
;
S RETURN("Request","IEN")=$G(REQUESTIEN)
;
D BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
Q
;
VALIDATE(REQUEST,FILEDATA,INSTITUTIONIEN,ERRORS) ;
N VALRETURN
; Validate required fields first, quit if any errors related to required variables
D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,2,$G(REQUEST("DFN")),1,,1,2)
;
D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,8.7,$G(REQUEST("APPOINTMENT TYPE")),0,,,180)
S FILEDATA("APPOINTMENT TYPE")=$G(VALRETURN(409.85,8.7,"I"))
;
; CLINIC VALIDATION - Quit here if validation fails. Clinic is needed for subsequent checks
;
I $G(REQUEST("CLINIC IEN"))'="" D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,44,$G(REQUEST("CLINIC IEN")),1,,,19)
;
I $G(REQUEST("CLINIC IEN"))="",$G(REQUEST("PRIMARY AMIS"))="" D ERRLOG^SDES2JSON(.ERRORS,530)
; CLINIC IEN or PRIMARY AMIS is allowed, NOT both
;
I $G(REQUEST("CLINIC IEN"))'="",($G(REQUEST("PRIMARY AMIS"))'=""!($G(REQUEST("CREDIT AMIS"))'="")) D ERRLOG^SDES2JSON(.ERRORS,202)
;
; cannot have credit amis with no primary amis
I $G(REQUEST("CREDIT AMIS"))'="",$G(REQUEST("PRIMARY AMIS"))="" D ERRLOG^SDES2JSON(.ERRORS,234)
I $G(REQUEST("PRIMARY AMIS"))'="" D VALPRIMAMIS(.ERRORS,.REQUEST,.FILEDATA)
;
I $G(REQUEST("CREDIT AMIS"))'="" D VALCREDITAMIS(.ERRORS,.REQUEST,.FILEDATA)
;
I $G(REQUEST("PRIMARY AMIS"))'="",$G(REQUEST("CREDIT AMIS"))'="" D CONDAMISCHECK^SDES2VAL44(.ERRORS,$G(REQUEST("PRIMARY AMIS")),$G(REQUEST("CREDIT AMIS")))
;
S FILEDATA("PATIENT INDICATED DATE")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(REQUEST("PATIENT INDICATED DATE")),$G(REQUEST("CLINIC IEN")),1,159,160)
;
D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10,$G(REQUEST("PRIORITY")),1,,457,211)
I VALRETURN S FILEDATA("PRIORITY")=$G(VALRETURN(409.85,10,"I"))
;
D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,11,$G(REQUEST("REQUESTED BY")),1,,62,198)
I VALRETURN D
.S FILEDATA("REQUESTED BY")=$G(VALRETURN(409.85,11,"I"))
.I $G(FILEDATA("REQUESTED BY"))=1 D Q
..D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,200,$G(REQUEST("PROVIDER IEN")),1,,53,54)
..I VALRETURN,('$$ACTIVE^XUSER($G(REQUEST("PROVIDER IEN")))!('$$ACTIVPRV^PXAPI($G(REQUEST("PROVIDER IEN"))))) D ERRLOG^SDES2JSON(.ERRORS,560)
;
D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,4,$G(REQUEST("REQUEST SUB TYPE")),1,,60,61)
;
I $G(REQUEST("CREATE DATE"))="" S FILEDATA("CREATE DATE")=$$FMTISO^SDAMUTDT(DT,$G(REQUEST("CLINIC IEN")))
S FILEDATA("CREATE DATE")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(FILEDATA("CREATE DATE")),$G(REQUEST("CLINIC IEN")),,,49)
;
S INSTITUTIONIEN=$$STATIONTOINST(.ERRORS,$G(REQUEST("STATION NUMBER")),$G(REQUEST("INSTITUTION NAME")))
;
; Validate Optional fields
I $L($G(REQUEST("MODALITY"))) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,6,$G(REQUEST("MODALITY")),,,,224) Q:'VALRETURN
.S FILEDATA("MODALITY")=$G(VALRETURN(409.85,6,"I"))
;
I $L($G(REQUEST("PRIORITY GROUP"))) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10.5,$G(REQUEST("PRIORITY GROUP")),,,,199) Q:'VALRETURN
.S FILEDATA("PRIORITY GROUP")=$G(VALRETURN(409.85,10.5,"I"))
;
I $L($G(REQUEST("SERVICE CONNECTED"))) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,15,$G(REQUEST("SERVICE CONNECTED")),,,,200)
.S FILEDATA("SERVICE CONNECTED")=$G(VALRETURN(409.85,15,"I"))
;
I $L($G(REQUEST("SERVICE CONNECTED PERCENTAGE"))) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,14,$G(REQUEST("SERVICE CONNECTED PERCENTAGE")),,,,201) Q:'VALRETURN
.;I $G(FILEDATA("SERVICE CONNECTED"))=0,+$G(REQUEST("SERVICE CONNECTED PERCENTAGE")) D ERRLOG^SDES2JSON(.ERRORS,232)
;
I $L($G(REQUEST("PATIENT STATUS"))) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,.02,$G(REQUEST("PATIENT STATUS")),,,,203) Q:'VALRETURN
.S FILEDATA("PATIENT STATUS")=$G(VALRETURN(409.85,.02,"I"))
;
I $L($G(REQUEST("REQUEST COMMENT"))) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$G(REQUEST("REQUEST COMMENT")),,,,443)
;
I $L($G(REQUEST("TIME SENSITIVE"))) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,47,$G(REQUEST("TIME SENSITIVE")))
.I VALRETURN S FILEDATA("TIME SENSITIVE")=$G(VALRETURN(409.85,47,"I"))
;
I $D(REQUEST("PATIENT PREFERRED START DATE")),$D(REQUEST("PATIENT PREFERRED END DATE")) D VALIDATEDATEPREF(.ERRORS,.REQUEST)
I $D(REQUEST("MRTC")) D VALIDATEMRTCDATA(.ERRORS,.REQUEST,.FILEDATA)
I $G(REQUEST("MRTC","PARENT REQUEST")),$G(REQUEST("DFN")) S FILEDATA("MRTC","CHILD SEQUENCE NUMBER")=$$MRTCHILDSEQUENCE($G(REQUEST("MRTC","PARENT REQUEST")),$G(REQUEST("DFN")))
I $G(REQUEST("MRTC","PARENT REQUEST")) D
. I $G(FILEDATA("MRTC","CHILD SEQUENCE NUMBER")),$G(FILEDATA("MRTC","CHILD SEQUENCE NUMBER"))>$$GET1^DIQ(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),43,"I") D ERRLOG^SDES2JSON(.ERRORS,544)
. S FILEDATA("MRTC","ORDER ID")=$$GET1^DIQ(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),46,"I")
Q
;
BUILDER(REQUEST,INSTITUTIONIEN,ORIGUSER,EAS) ;
N FDA,RETURNIEN
S FDA(409.85,"+1,",.01)=$G(REQUEST("DFN"))
S FDA(409.85,"+1,",.02)=$G(REQUEST("PATIENT STATUS"))
S FDA(409.85,"+1,",1)=$G(REQUEST("CREATE DATE"))
S FDA(409.85,"+1,",2)=$G(INSTITUTIONIEN)
S FDA(409.85,"+1,",4)=$G(REQUEST("REQUEST SUB TYPE"))
S FDA(409.85,"+1,",5)=$G(REQUEST("VAOS GUID"))
S FDA(409.85,"+1,",6)=$G(REQUEST("MODALITY"))
S FDA(409.85,"+1,",8)=$G(REQUEST("CLINIC IEN"))
S FDA(409.85,"+1,",8.5)=$G(REQUEST("PRIMARY AMIS"))
S FDA(409.85,"+1,",8.6)=$G(REQUEST("CREDIT AMIS"))
S FDA(409.85,"+1,",8.7)=$G(REQUEST("APPOINTMENT TYPE"))
S FDA(409.85,"+1,",9)=$G(ORIGUSER)
S FDA(409.85,"+1,",9.5)=$$NOW^XLFDT
S FDA(409.85,"+1,",10)=$G(REQUEST("PRIORITY"))
S FDA(409.85,"+1,",10.5)=$G(REQUEST("PRIORITY GROUP"))
S FDA(409.85,"+1,",11)=$G(REQUEST("REQUESTED BY"))
S FDA(409.85,"+1,",12)=$G(REQUEST("PROVIDER IEN"))
S FDA(409.85,"+1,",14)=$G(REQUEST("SERVICE CONNECTED PERCENTAGE"))
S FDA(409.85,"+1,",15)=$G(REQUEST("SERVICE CONNECTED"))
S FDA(409.85,"+1,",22)=$G(REQUEST("PATIENT INDICATED DATE"))
S FDA(409.85,"+1,",23)="O"
S FDA(409.85,"+1,",25)=$G(REQUEST("REQUEST COMMENT"))
S FDA(409.85,"+1,",41)=$G(REQUEST("MRTC","NEEDED"))
S FDA(409.85,"+1,",42)=$G(REQUEST("MRTC","DAYS BETWEEN APPTS"))
S FDA(409.85,"+1,",43)=$G(REQUEST("MRTC","HOW MANY NEEDED"))
S FDA(409.85,"+1,",43.1)=$G(REQUEST("MRTC","CHILD SEQUENCE NUMBER"))
S FDA(409.85,"+1,",43.8)=$G(REQUEST("MRTC","PARENT REQUEST"))
S FDA(409.85,"+1,",46)=$G(REQUEST("MRTC","ORDER ID"))
S FDA(409.85,"+1,",47)=$S($G(REQUEST("TIME SENSITIVE"))'="":$G(REQUEST("TIME SENSITIVE")),1:0)
S FDA(409.85,"+1,",49)=$G(REQUEST("PID CHANGE ALLOWED"))
S FDA(409.85,"+1,",100)=$G(EAS)
;
D UPDATE^DIE("","FDA","RETURNIEN") K FDA
S REQUESTIEN=$G(RETURNIEN(1))
;
; 409.85 COMMENTS AUDIT multiple
I $G(REQUEST("REQUEST COMMENT"))'="" D
. S FDA(409.8527,"+1,"_REQUESTIEN_",",.01)=$$NOW^XLFDT
. S FDA(409.8527,"+1,"_REQUESTIEN_",",1)=ORIGUSER
. S FDA(409.8527,"+1,"_REQUESTIEN_",",2)=$G(REQUEST("REQUEST COMMENT"))
. D UPDATE^DIE("","FDA") K FDA
;
D ADDPIDHISTORY(REQUESTIEN,$G(REQUEST("PATIENT INDICATED DATE")),ORIGUSER)
;
I $G(REQUEST("MRTC","PARENT REQUEST"))'=""&($G(REQUESTIEN)'="") D ADDMRTCMULT(REQUESTIEN,REQUEST("MRTC","PARENT REQUEST"),REQUEST("PATIENT INDICATED DATE"))
;
I ($D(REQUEST("PATIENT COMMENT")))!($D(REQUEST("PATIENT PREFERRED START DATE"))) D BUILDCOMMENTS(.REQUEST,REQUESTIEN)
;
D AUDIT(REQUESTIEN,$G(REQUEST("CLINIC IEN")),$G(REQUEST("PRIMARY AMIS")),ORIGUSER)
;
Q REQUESTIEN
;
ADDPIDHISTORY(REQUESTIEN,PID,USER) ;
N PIDFDA,FDA,OLDPID,PARENTIEN
;
I PID=$$GET1^DIQ(409.854,$O(^SDEC(409.85,REQUESTIEN,10,"A"),-1)_","_REQUESTIEN_",",1,"I") Q
;
S PIDFDA(409.854,"+1,"_REQUESTIEN_",",.01)=$$NOW^XLFDT
S PIDFDA(409.854,"+1,"_REQUESTIEN_",",1)=PID
S PIDFDA(409.854,"+1,"_REQUESTIEN_",",2)=$$GET1^DIQ(200,$G(USER),.01,"E")
D UPDATE^DIE(,"PIDFDA") K PIDFDA
;
S OLDPID=$$GET1^DIQ(409.85,REQUESTIEN_",",22,"I")
S PARENTIEN=$$GET1^DIQ(409.85,REQUESTIEN_",",43.8,"I")
;
S FDA(409.85,REQUESTIEN_",",22)=PID
D FILE^DIE(,"FDA") K FDA
;
I PARENTIEN,$D(^SDEC(409.85,PARENTIEN)) D
. N PREFIEN S PREFIEN=$O(^SDEC(409.85,PARENTIEN,5,"B",OLDPID,0))
. S FDA(409.851,PREFIEN_","_PARENTIEN_",",.01)=PID
. D FILE^DIE(,"FDA") K FDA
Q
;
ADDMRTCMULT(CHILD,PARENT,PATIENTINDDATE) ;Update the MRTC subfiles
D ADDMRTCLINKS(CHILD,PARENT)
D ADDMRTCPIDLINKS(PARENT,PATIENTINDDATE)
Q
;
ADDMRTCLINKS(CHILD,PARENT) ;
N FDA
Q:$O(^SDEC(409.85,PARENT,2,"B",CHILD))
S FDA(409.852,"+1,"_PARENT_",",.01)=CHILD
D UPDATE^DIE(,"FDA") K FDA
Q
;
ADDMRTCPIDLINKS(PARENT,PATIENTINDDATE) ;
N SDFDA
Q:$O(^SDEC(409.85,PARENT,5,"B",PATIENTINDDATE,0))
S SDFDA(409.851,"+1,"_PARENT_",",.01)=PATIENTINDDATE
D UPDATE^DIE("","SDFDA") K SDFDA
Q
;
MRTCHILDSEQUENCE(PARENTREQUESTIEN,DFN) ; return next sequence # for child mrtc
N COUNT,REQUESTIEN,IENS,NEXTSEQUENCENUM,CHILD,LASTCHILD
S REQUESTIEN=0,COUNT=0,LASTCHILD=""
F S REQUESTIEN=$O(^SDEC(409.85,"B",DFN,REQUESTIEN)) Q:'REQUESTIEN D
.I $$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")=PARENTREQUESTIEN D
..S COUNT=COUNT+1
..S CHILD(REQUESTIEN)=COUNT
I $D(CHILD) D
.S LASTCHILD=$O(CHILD(LASTCHILD),-1)
.S NEXTSEQUENCENUM=$G(CHILD($G(LASTCHILD)))+1
I '$D(CHILD) S NEXTSEQUENCENUM=1
Q NEXTSEQUENCENUM
;
AUDIT(REQUESTIEN,CLINICIEN,STOPCODE,ORIGUSER) ;
N FDA
S FDA(409.8545,"+1,"_REQUESTIEN_",",.01)=$$NOW^XLFDT
S FDA(409.8545,"+1,"_REQUESTIEN_",",1)=$G(ORIGUSER)
S FDA(409.8545,"+1,"_REQUESTIEN_",",2)=$G(CLINICIEN)
S FDA(409.8545,"+1,"_REQUESTIEN_",",3)=$G(STOPCODE)
D UPDATE^DIE("","FDA") K FDA
Q
N REQCOMMS,NUM,NUM2,DONE,PREFDATES,PATCOMMS,RANGE,COUNT
S NUM=0
;
I $D(REQUEST("PATIENT COMMENT")) D
.D WP^SDECUTL(.PATCOMMS,$G(REQUEST("PATIENT COMMENT")))
.D WP^DIE(409.85,REQUESTIEN_",",60,"","PATCOMMS")
;
I '$G(REQUEST("PATIENT PREFERRED START DATE",1)) Q
;
S NUM=0,COUNT="",COUNT=$O(REQUEST("PATIENT PREFERRED START DATE",COUNT),-1)
F NUM=1:1:COUNT D
.S STARTDATE=$G(REQUEST("PATIENT PREFERRED START DATE",NUM))
.S ENDDATE=$G(REQUEST("PATIENT PREFERRED END DATE",NUM))
.S STARTDATE=$$ISOTFM^SDAMUTDT(STARTDATE),STARTDATE=$$FMTE^XLFDT(STARTDATE)
.S ENDDATE=$$ISOTFM^SDAMUTDT(ENDDATE),ENDDATE=$$FMTE^XLFDT(ENDDATE)
.S RANGE(NUM)="Patient preferred date range #"_NUM_": "_STARTDATE_" to "_ENDDATE
D WP^DIE(409.85,REQUESTIEN_",",60,"A","RANGE")
Q
;
STATIONTOINST(ERRORS,STATIONNUM,INSTNAME) ;
N INSTITUTIONIEN
I STATIONNUM="",INSTNAME="" D ERRLOG^SDES2JSON(.ERRORS,204) Q 0
I STATIONNUM="",INSTNAME'="" S INSTITUTIONIEN=$$FIND1^DIC(4,"","X",INSTNAME,"B") I 'INSTITUTIONIEN D ERRLOG^SDES2JSON(.ERRORS,205) Q 0
I STATIONNUM'="" S INSTITUTIONIEN=$$FIND1^DIC(4,"","X",STATIONNUM,"D") I 'INSTITUTIONIEN D ERRLOG^SDES2JSON(.ERRORS,197) Q 0
Q INSTITUTIONIEN
;
VALPRIMAMIS(ERRORS,REQUEST,FDATA) ; PRIMARY AMIS STOP CODE
N SDPRIMAMIS,SDAMISERROR
S SDPRIMAMIS=$G(REQUEST("PRIMARY AMIS"))
S SDAMISERROR=$$VALIDATEAMIS^SDES2UTIL(.SDPRIMAMIS,"P")
I SDAMISERROR D ERRLOG^SDES2JSON(.ERRORS,SDAMISERROR) Q
S FDATA("PRIMARY AMIS")=SDPRIMAMIS
Q
;
VALCREDITAMIS(ERRORS,REQUEST,FDATA) ; CREDIT AMIS STOP CODE
N SDCREDITAMIS,SDAMISERROR
S SDCREDITAMIS=$G(REQUEST("CREDIT AMIS"))
S SDAMISERROR=$$VALIDATEAMIS^SDES2UTIL(.SDCREDITAMIS,"C")
I SDAMISERROR D ERRLOG^SDES2JSON(.ERRORS,SDAMISERROR) Q
S FDATA("CREDIT AMIS")=SDCREDITAMIS
Q
;
VALIDATEDATEPREF(ERRORS,REQUEST) ;
N ARYIEN,ARYIEN2,DATE,ERR,STARTDATE,ENDDATE
S ARYIEN=0,ERR=0
F S ARYIEN=$O(REQUEST("PATIENT PREFERRED START DATE",ARYIEN)) Q:'ARYIEN!($G(ERR)) D
.S STARTDATE=$G(REQUEST("PATIENT PREFERRED START DATE",ARYIEN))
.S STARTDATE=$$ISOTFM^SDAMUTDT(STARTDATE)
.I STARTDATE=-1!($L(STARTDATE,".")=1) S ERR=1 D ERRLOG^SDES2JSON(.ERRORS,206) Q
.S ENDDATE=$G(REQUEST("PATIENT PREFERRED END DATE",ARYIEN))
.S ENDDATE=$$ISOTFM^SDAMUTDT(ENDDATE)
.I ENDDATE=-1!($L(ENDDATE,".")=1) S ERR=1 D ERRLOG^SDES2JSON(.ERRORS,206) Q
.I ENDDATE<STARTDATE D ERRLOG^SDES2JSON(.ERRORS,29,"Start Date:"_STARTDATE_" - End Date: "_ENDDATE)
I $G(REQUEST("PATIENT PREFERRED START DATE",1)),'$G(REQUEST("PATIENT PREFERRED END DATE",1)) D ERRLOG^SDES2JSON(.ERRORS,195) Q
I $G(REQUEST("PATIENT PREFERRED START DATE",2)),'$G(REQUEST("PATIENT PREFERRED END DATE",2)) D ERRLOG^SDES2JSON(.ERRORS,195) Q
I $G(REQUEST("PATIENT PREFERRED START DATE",3)),'$G(REQUEST("PATIENT PREFERRED END DATE",3)) D ERRLOG^SDES2JSON(.ERRORS,195) Q
I '$G(REQUEST("PATIENT PREFERRED START DATE",1)),$G(REQUEST("PATIENT PREFERRED END DATE",1)) D ERRLOG^SDES2JSON(.ERRORS,195) Q
I '$G(REQUEST("PATIENT PREFERRED START DATE",2)),$G(REQUEST("PATIENT PREFERRED END DATE",2)) D ERRLOG^SDES2JSON(.ERRORS,195) Q
I '$G(REQUEST("PATIENT PREFERRED START DATE",3)),$G(REQUEST("PATIENT PREFERRED END DATE",3)) D ERRLOG^SDES2JSON(.ERRORS,195) Q
Q
;
VALIDATEMRTCDATA(ERRORS,REQUEST,FILEDATA) ;
N VRET
D VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,41,$G(REQUEST("MRTC","NEEDED")),1,,539,208)
S FILEDATA("MRTC","NEEDED")=$G(VRET(409.85,41,"I"))
; if this is not an mrtc, check for other mrtc fields and quit
I $G(FILEDATA("MRTC","NEEDED"))=0 D Q
.I $D(REQUEST("MRTC","PARENT REQUEST"))!($D(REQUEST("MRTC","DAYS BETWEEN APPTS")))!(($D(REQUEST("MRTC","HOW MANY NEEDED")))) D ERRLOG^SDES2JSON(.ERRORS,233)
; if this is an MRTC, validate fields as required
I $G(REQUEST("MRTC","PARENT REQUEST"))'="" D
.D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,409.85,$G(REQUEST("MRTC","PARENT REQUEST")),1,,536,207)
.I VRET D
..I $$GET1^DIQ(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),.01,"I")'=$G(REQUEST("DFN")) D ERRLOG^SDES2JSON(.ERRORS,533)
..I $$GET1^DIQ(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),42,"I")'=$G(REQUEST("MRTC","DAYS BETWEEN APPTS")) D ERRLOG^SDES2JSON(.ERRORS,52,"DAYS BETWEEN does not match parent.")
..I $$GET1^DIQ(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),43,"I")'=$G(REQUEST("MRTC","HOW MANY NEEDED")) D ERRLOG^SDES2JSON(.ERRORS,52,"HOW MANY NEEDED does not match parent.")
D VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,42,$G(REQUEST("MRTC","DAYS BETWEEN APPTS")),1,,537,209)
D VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,43,$G(REQUEST("MRTC","HOW MANY NEEDED")),1,,538,210)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2CRTAPREQ 18286 printed Dec 13, 2024@02:53:37 Page 2
SDES2CRTAPREQ ;ALB/BWF,JAS,TJB,JAS - CREATE APPOINTMENT REQUEST ; OCT 7, 2024
+1 ;;5.3;Scheduling;**869,871,875,877,893**;Aug 13, 1993;Build 6
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$ACTIVPRV^PXAPI is supported by IA #2349
+7 ; Reference to $$ACTIVE^XUSER is supported by IA #2343
+8 QUIT
+9 ; RPC: SDES2 CREATE APPT REQ
+10 ;
+11 ; SDCONTEXT INPUT
+12 ;
+13 ;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+14 ;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+15 ;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+16 ;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+17 ;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+18 ;
+19 ; REQUEST INPUT FORMAT
+20 ;
+21 ;S REQUEST("DFN")="" REQ (PATIENT IEN)
+22 ;S REQUEST("APPOINTMENT TYPE")="" REQ - APPOINTMENT TYPE - can be the Name or IEN
+23 ;S REQUEST("PATIENT INDICATED DATE")="" REQ (PID DATE IN ISO FORMAT)
+24 ;S REQUEST("PRIORITY")="" REQ
+25 ;S REQUEST("REQUEST SUB TYPE")="" REQ
+26 ;S REQUEST("REQUESTED BY")="" REQ
+27 ;S REQUEST("CLINIC IEN")="" OPT/REQ \
+28 ;S REQUEST("PRIMARY AMIS")="" OPT/REQ---> Either CLINIC IEN or PRIMARY AMIS/CREDIT PRIMARY AMIS must be defined
+29 ;S REQUEST("CREDIT AMIS")="" OPT/REQ /
+30 ;S REQUEST("STATION NUMBER")="" OPT/REQ -- > Either STATION NUMBER or INSTITUTION NAME is REQUIRED
+31 ;S REQUEST("INSTITUTION NAME")="" OPT/REQ --/
+32 ;S REQUEST("CREATE DATE")="" OPT - Defaults to today if not sent
+33 ;S REQUEST("PROVIDER IEN")="" OPT (Required if 'REQUESTED BY' is 'PROVIDER')
+34 ;S REQUEST("PRIORITY GROUP")="" OPT
+35 ;S REQUEST("SERVICE CONNECTED")="" OPT (This is for PRIORITY; 1 OR 0, if passed)
+36 ;S REQUEST("SERVICE CONNECTED PERCENTAGE")="" OPT
+37 ;S REQUEST("MODALITY")="" OPT
+38 ;S REQUEST("PATIENT STATUS")="" OPT
+39 ;S REQUEST("VAOS GUID")="" OPT
+40 ;S REQUEST("TIME SENSITIVE")="" OPT
+41 ;S REQUEST("REQUEST COMMENT")="" OPT
+42 ;S REQUEST("PATIENT COMMENT")="" OPT
+43 ;S REQUEST("PATIENT PREFERRED START DATE",1)="" OPT
+44 ;S REQUEST("PATIENT PREFERRED END DATE",1)="" OPT
+45 ;S REQUEST("PATIENT PREFERRED START DATE",2)="" OPT
+46 ;S REQUEST("PATIENT PREFERRED END DATE",2)="" OPT
+47 ;S REQUEST("PATIENT PREFERRED START DATE",3)="" OPT
+48 ;S REQUEST("PATIENT PREFERRED END DATE",3)="" OPT
+49 ;S REQUEST("MRTC","NEEDED")="" OPT (YES/NO)
+50 ;S REQUEST("MRTC","PARENT REQUEST")="" OPT
+51 ;S REQUEST("MRTC","DAYS BETWEEN APPTS")="" OPT
+52 ;S REQUEST("MRTC","HOW MANY NEEDED")="" OPT
+53 ;
CREATEREQUEST(JSONRETURN,SDCONTEXT,REQUEST) ;
+1 NEW REQUESTIEN,ERRORS,RETURN,INSTITUTIONIEN,FILEDATA,ORIGUSER
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("Request",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+5 SET ORIGUSER=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
+6 ;
+7 MERGE FILEDATA=REQUEST
+8 DO VALIDATE(.REQUEST,.FILEDATA,.INSTITUTIONIEN,.ERRORS)
+9 ;
+10 IF $DATA(ERRORS)
SET ERRORS("Request",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+11 ;
+12 SET REQUESTIEN=$$BUILDER(.FILEDATA,INSTITUTIONIEN,ORIGUSER,$GET(SDCONTEXT("ACHERON AUDIT ID")))
+13 ;
+14 SET RETURN("Request","IEN")=$GET(REQUESTIEN)
+15 ;
+16 DO BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
+17 QUIT
+18 ;
VALIDATE(REQUEST,FILEDATA,INSTITUTIONIEN,ERRORS) ;
+1 NEW VALRETURN
+2 ; Validate required fields first, quit if any errors related to required variables
+3 DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,2,$GET(REQUEST("DFN")),1,,1,2)
+4 ;
+5 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,8.7,$GET(REQUEST("APPOINTMENT TYPE")),0,,,180)
+6 SET FILEDATA("APPOINTMENT TYPE")=$GET(VALRETURN(409.85,8.7,"I"))
+7 ;
+8 ; CLINIC VALIDATION - Quit here if validation fails. Clinic is needed for subsequent checks
+9 ;
+10 IF $GET(REQUEST("CLINIC IEN"))'=""
DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,44,$GET(REQUEST("CLINIC IEN")),1,,,19)
+11 ;
+12 IF $GET(REQUEST("CLINIC IEN"))=""
IF $GET(REQUEST("PRIMARY AMIS"))=""
DO ERRLOG^SDES2JSON(.ERRORS,530)
+13 ; CLINIC IEN or PRIMARY AMIS is allowed, NOT both
+14 ;
+15 IF $GET(REQUEST("CLINIC IEN"))'=""
IF ($GET(REQUEST("PRIMARY AMIS"))'=""!($GET(REQUEST("CREDIT AMIS"))'=""))
DO ERRLOG^SDES2JSON(.ERRORS,202)
+16 ;
+17 ; cannot have credit amis with no primary amis
+18 IF $GET(REQUEST("CREDIT AMIS"))'=""
IF $GET(REQUEST("PRIMARY AMIS"))=""
DO ERRLOG^SDES2JSON(.ERRORS,234)
+19 IF $GET(REQUEST("PRIMARY AMIS"))'=""
DO VALPRIMAMIS(.ERRORS,.REQUEST,.FILEDATA)
+20 ;
+21 IF $GET(REQUEST("CREDIT AMIS"))'=""
DO VALCREDITAMIS(.ERRORS,.REQUEST,.FILEDATA)
+22 ;
+23 IF $GET(REQUEST("PRIMARY AMIS"))'=""
IF $GET(REQUEST("CREDIT AMIS"))'=""
DO CONDAMISCHECK^SDES2VAL44(.ERRORS,$GET(REQUEST("PRIMARY AMIS")),$GET(REQUEST("CREDIT AMIS")))
+24 ;
+25 SET FILEDATA("PATIENT INDICATED DATE")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$GET(REQUEST("PATIENT INDICATED DATE")),$GET(REQUEST("CLINIC IEN")),1,159,160)
+26 ;
+27 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10,$GET(REQUEST("PRIORITY")),1,,457,211)
+28 IF VALRETURN
SET FILEDATA("PRIORITY")=$GET(VALRETURN(409.85,10,"I"))
+29 ;
+30 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,11,$GET(REQUEST("REQUESTED BY")),1,,62,198)
+31 IF VALRETURN
Begin DoDot:1
+32 SET FILEDATA("REQUESTED BY")=$GET(VALRETURN(409.85,11,"I"))
+33 IF $GET(FILEDATA("REQUESTED BY"))=1
Begin DoDot:2
+34 DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,200,$GET(REQUEST("PROVIDER IEN")),1,,53,54)
+35 IF VALRETURN
IF ('$$ACTIVE^XUSER($GET(REQUEST("PROVIDER IEN")))!('$$ACTIVPRV^PXAPI($GET(REQUEST("PROVIDER IEN")))))
DO ERRLOG^SDES2JSON(.ERRORS,560)
End DoDot:2
QUIT
End DoDot:1
+36 ;
+37 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,4,$GET(REQUEST("REQUEST SUB TYPE")),1,,60,61)
+38 ;
+39 IF $GET(REQUEST("CREATE DATE"))=""
SET FILEDATA("CREATE DATE")=$$FMTISO^SDAMUTDT(DT,$GET(REQUEST("CLINIC IEN")))
+40 SET FILEDATA("CREATE DATE")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$GET(FILEDATA("CREATE DATE")),$GET(REQUEST("CLINIC IEN")),,,49)
+41 ;
+42 SET INSTITUTIONIEN=$$STATIONTOINST(.ERRORS,$GET(REQUEST("STATION NUMBER")),$GET(REQUEST("INSTITUTION NAME")))
+43 ;
+44 ; Validate Optional fields
+45 IF $LENGTH($GET(REQUEST("MODALITY")))
Begin DoDot:1
+46 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,6,$GET(REQUEST("MODALITY")),,,,224)
if 'VALRETURN
QUIT
+47 SET FILEDATA("MODALITY")=$GET(VALRETURN(409.85,6,"I"))
End DoDot:1
+48 ;
+49 IF $LENGTH($GET(REQUEST("PRIORITY GROUP")))
Begin DoDot:1
+50 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10.5,$GET(REQUEST("PRIORITY GROUP")),,,,199)
if 'VALRETURN
QUIT
+51 SET FILEDATA("PRIORITY GROUP")=$GET(VALRETURN(409.85,10.5,"I"))
End DoDot:1
+52 ;
+53 IF $LENGTH($GET(REQUEST("SERVICE CONNECTED")))
Begin DoDot:1
+54 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,15,$GET(REQUEST("SERVICE CONNECTED")),,,,200)
+55 SET FILEDATA("SERVICE CONNECTED")=$GET(VALRETURN(409.85,15,"I"))
End DoDot:1
+56 ;
+57 IF $LENGTH($GET(REQUEST("SERVICE CONNECTED PERCENTAGE")))
Begin DoDot:1
+58 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,14,$GET(REQUEST("SERVICE CONNECTED PERCENTAGE")),,,,201)
if 'VALRETURN
QUIT
+59 ;I $G(FILEDATA("SERVICE CONNECTED"))=0,+$G(REQUEST("SERVICE CONNECTED PERCENTAGE")) D ERRLOG^SDES2JSON(.ERRORS,232)
End DoDot:1
+60 ;
+61 IF $LENGTH($GET(REQUEST("PATIENT STATUS")))
Begin DoDot:1
+62 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,.02,$GET(REQUEST("PATIENT STATUS")),,,,203)
if 'VALRETURN
QUIT
+63 SET FILEDATA("PATIENT STATUS")=$GET(VALRETURN(409.85,.02,"I"))
End DoDot:1
+64 ;
+65 IF $LENGTH($GET(REQUEST("REQUEST COMMENT")))
Begin DoDot:1
+66 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$GET(REQUEST("REQUEST COMMENT")),,,,443)
End DoDot:1
+67 ;
+68 IF $LENGTH($GET(REQUEST("TIME SENSITIVE")))
Begin DoDot:1
+69 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,47,$GET(REQUEST("TIME SENSITIVE")))
+70 IF VALRETURN
SET FILEDATA("TIME SENSITIVE")=$GET(VALRETURN(409.85,47,"I"))
End DoDot:1
+71 ;
+72 IF $DATA(REQUEST("PATIENT PREFERRED START DATE"))
IF $DATA(REQUEST("PATIENT PREFERRED END DATE"))
DO VALIDATEDATEPREF(.ERRORS,.REQUEST)
+73 IF $DATA(REQUEST("MRTC"))
DO VALIDATEMRTCDATA(.ERRORS,.REQUEST,.FILEDATA)
+74 IF $GET(REQUEST("MRTC","PARENT REQUEST"))
IF $GET(REQUEST("DFN"))
SET FILEDATA("MRTC","CHILD SEQUENCE NUMBER")=$$MRTCHILDSEQUENCE($GET(REQUEST("MRTC","PARENT REQUEST")),$GET(REQUEST("DFN")))
+75 IF $GET(REQUEST("MRTC","PARENT REQUEST"))
Begin DoDot:1
+76 IF $GET(FILEDATA("MRTC","CHILD SEQUENCE NUMBER"))
IF $GET(FILEDATA("MRTC","CHILD SEQUENCE NUMBER"))>$$GET1^DIQ(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),43,"I")
DO ERRLOG^SDES2JSON(.ERRORS,544)
+77 SET FILEDATA("MRTC","ORDER ID")=$$GET1^DIQ(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),46,"I")
End DoDot:1
+78 QUIT
+79 ;
BUILDER(REQUEST,INSTITUTIONIEN,ORIGUSER,EAS) ;
+1 NEW FDA,RETURNIEN
+2 SET FDA(409.85,"+1,",.01)=$GET(REQUEST("DFN"))
+3 SET FDA(409.85,"+1,",.02)=$GET(REQUEST("PATIENT STATUS"))
+4 SET FDA(409.85,"+1,",1)=$GET(REQUEST("CREATE DATE"))
+5 SET FDA(409.85,"+1,",2)=$GET(INSTITUTIONIEN)
+6 SET FDA(409.85,"+1,",4)=$GET(REQUEST("REQUEST SUB TYPE"))
+7 SET FDA(409.85,"+1,",5)=$GET(REQUEST("VAOS GUID"))
+8 SET FDA(409.85,"+1,",6)=$GET(REQUEST("MODALITY"))
+9 SET FDA(409.85,"+1,",8)=$GET(REQUEST("CLINIC IEN"))
+10 SET FDA(409.85,"+1,",8.5)=$GET(REQUEST("PRIMARY AMIS"))
+11 SET FDA(409.85,"+1,",8.6)=$GET(REQUEST("CREDIT AMIS"))
+12 SET FDA(409.85,"+1,",8.7)=$GET(REQUEST("APPOINTMENT TYPE"))
+13 SET FDA(409.85,"+1,",9)=$GET(ORIGUSER)
+14 SET FDA(409.85,"+1,",9.5)=$$NOW^XLFDT
+15 SET FDA(409.85,"+1,",10)=$GET(REQUEST("PRIORITY"))
+16 SET FDA(409.85,"+1,",10.5)=$GET(REQUEST("PRIORITY GROUP"))
+17 SET FDA(409.85,"+1,",11)=$GET(REQUEST("REQUESTED BY"))
+18 SET FDA(409.85,"+1,",12)=$GET(REQUEST("PROVIDER IEN"))
+19 SET FDA(409.85,"+1,",14)=$GET(REQUEST("SERVICE CONNECTED PERCENTAGE"))
+20 SET FDA(409.85,"+1,",15)=$GET(REQUEST("SERVICE CONNECTED"))
+21 SET FDA(409.85,"+1,",22)=$GET(REQUEST("PATIENT INDICATED DATE"))
+22 SET FDA(409.85,"+1,",23)="O"
+23 SET FDA(409.85,"+1,",25)=$GET(REQUEST("REQUEST COMMENT"))
+24 SET FDA(409.85,"+1,",41)=$GET(REQUEST("MRTC","NEEDED"))
+25 SET FDA(409.85,"+1,",42)=$GET(REQUEST("MRTC","DAYS BETWEEN APPTS"))
+26 SET FDA(409.85,"+1,",43)=$GET(REQUEST("MRTC","HOW MANY NEEDED"))
+27 SET FDA(409.85,"+1,",43.1)=$GET(REQUEST("MRTC","CHILD SEQUENCE NUMBER"))
+28 SET FDA(409.85,"+1,",43.8)=$GET(REQUEST("MRTC","PARENT REQUEST"))
+29 SET FDA(409.85,"+1,",46)=$GET(REQUEST("MRTC","ORDER ID"))
+30 SET FDA(409.85,"+1,",47)=$SELECT($GET(REQUEST("TIME SENSITIVE"))'="":$GET(REQUEST("TIME SENSITIVE")),1:0)
+31 SET FDA(409.85,"+1,",49)=$GET(REQUEST("PID CHANGE ALLOWED"))
+32 SET FDA(409.85,"+1,",100)=$GET(EAS)
+33 ;
+34 DO UPDATE^DIE("","FDA","RETURNIEN")
KILL FDA
+35 SET REQUESTIEN=$GET(RETURNIEN(1))
+36 ;
+37 ; 409.85 COMMENTS AUDIT multiple
+38 IF $GET(REQUEST("REQUEST COMMENT"))'=""
Begin DoDot:1
+39 SET FDA(409.8527,"+1,"_REQUESTIEN_",",.01)=$$NOW^XLFDT
+40 SET FDA(409.8527,"+1,"_REQUESTIEN_",",1)=ORIGUSER
+41 SET FDA(409.8527,"+1,"_REQUESTIEN_",",2)=$GET(REQUEST("REQUEST COMMENT"))
+42 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:1
+43 ;
+44 DO ADDPIDHISTORY(REQUESTIEN,$GET(REQUEST("PATIENT INDICATED DATE")),ORIGUSER)
+45 ;
+46 IF $GET(REQUEST("MRTC","PARENT REQUEST"))'=""&($GET(REQUESTIEN)'="")
DO ADDMRTCMULT(REQUESTIEN,REQUEST("MRTC","PARENT REQUEST"),REQUEST("PATIENT INDICATED DATE"))
+47 ;
+48 IF ($DATA(REQUEST("PATIENT COMMENT")))!($DATA(REQUEST("PATIENT PREFERRED START DATE")))
DO BUILDCOMMENTS(.REQUEST,REQUESTIEN)
+49 ;
+50 DO AUDIT(REQUESTIEN,$GET(REQUEST("CLINIC IEN")),$GET(REQUEST("PRIMARY AMIS")),ORIGUSER)
+51 ;
+52 QUIT REQUESTIEN
+53 ;
ADDPIDHISTORY(REQUESTIEN,PID,USER) ;
+1 NEW PIDFDA,FDA,OLDPID,PARENTIEN
+2 ;
+3 IF PID=$$GET1^DIQ(409.854,$ORDER(^SDEC(409.85,REQUESTIEN,10,"A"),-1)_","_REQUESTIEN_",",1,"I")
QUIT
+4 ;
+5 SET PIDFDA(409.854,"+1,"_REQUESTIEN_",",.01)=$$NOW^XLFDT
+6 SET PIDFDA(409.854,"+1,"_REQUESTIEN_",",1)=PID
+7 SET PIDFDA(409.854,"+1,"_REQUESTIEN_",",2)=$$GET1^DIQ(200,$GET(USER),.01,"E")
+8 DO UPDATE^DIE(,"PIDFDA")
KILL PIDFDA
+9 ;
+10 SET OLDPID=$$GET1^DIQ(409.85,REQUESTIEN_",",22,"I")
+11 SET PARENTIEN=$$GET1^DIQ(409.85,REQUESTIEN_",",43.8,"I")
+12 ;
+13 SET FDA(409.85,REQUESTIEN_",",22)=PID
+14 DO FILE^DIE(,"FDA")
KILL FDA
+15 ;
+16 IF PARENTIEN
IF $DATA(^SDEC(409.85,PARENTIEN))
Begin DoDot:1
+17 NEW PREFIEN
SET PREFIEN=$ORDER(^SDEC(409.85,PARENTIEN,5,"B",OLDPID,0))
+18 SET FDA(409.851,PREFIEN_","_PARENTIEN_",",.01)=PID
+19 DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+20 QUIT
+21 ;
ADDMRTCMULT(CHILD,PARENT,PATIENTINDDATE) ;Update the MRTC subfiles
+1 DO ADDMRTCLINKS(CHILD,PARENT)
+2 DO ADDMRTCPIDLINKS(PARENT,PATIENTINDDATE)
+3 QUIT
+4 ;
ADDMRTCLINKS(CHILD,PARENT) ;
+1 NEW FDA
+2 if $ORDER(^SDEC(409.85,PARENT,2,"B",CHILD))
QUIT
+3 SET FDA(409.852,"+1,"_PARENT_",",.01)=CHILD
+4 DO UPDATE^DIE(,"FDA")
KILL FDA
+5 QUIT
+6 ;
ADDMRTCPIDLINKS(PARENT,PATIENTINDDATE) ;
+1 NEW SDFDA
+2 if $ORDER(^SDEC(409.85,PARENT,5,"B",PATIENTINDDATE,0))
QUIT
+3 SET SDFDA(409.851,"+1,"_PARENT_",",.01)=PATIENTINDDATE
+4 DO UPDATE^DIE("","SDFDA")
KILL SDFDA
+5 QUIT
+6 ;
MRTCHILDSEQUENCE(PARENTREQUESTIEN,DFN) ; return next sequence # for child mrtc
+1 NEW COUNT,REQUESTIEN,IENS,NEXTSEQUENCENUM,CHILD,LASTCHILD
+2 SET REQUESTIEN=0
SET COUNT=0
SET LASTCHILD=""
+3 FOR
SET REQUESTIEN=$ORDER(^SDEC(409.85,"B",DFN,REQUESTIEN))
if 'REQUESTIEN
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")=PARENTREQUESTIEN
Begin DoDot:2
+5 SET COUNT=COUNT+1
+6 SET CHILD(REQUESTIEN)=COUNT
End DoDot:2
End DoDot:1
+7 IF $DATA(CHILD)
Begin DoDot:1
+8 SET LASTCHILD=$ORDER(CHILD(LASTCHILD),-1)
+9 SET NEXTSEQUENCENUM=$GET(CHILD($GET(LASTCHILD)))+1
End DoDot:1
+10 IF '$DATA(CHILD)
SET NEXTSEQUENCENUM=1
+11 QUIT NEXTSEQUENCENUM
+12 ;
AUDIT(REQUESTIEN,CLINICIEN,STOPCODE,ORIGUSER) ;
+1 NEW FDA
+2 SET FDA(409.8545,"+1,"_REQUESTIEN_",",.01)=$$NOW^XLFDT
+3 SET FDA(409.8545,"+1,"_REQUESTIEN_",",1)=$GET(ORIGUSER)
+4 SET FDA(409.8545,"+1,"_REQUESTIEN_",",2)=$GET(CLINICIEN)
+5 SET FDA(409.8545,"+1,"_REQUESTIEN_",",3)=$GET(STOPCODE)
+6 DO UPDATE^DIE("","FDA")
KILL FDA
+7 QUIT
+1 NEW REQCOMMS,NUM,NUM2,DONE,PREFDATES,PATCOMMS,RANGE,COUNT
+2 SET NUM=0
+3 ;
+4 IF $DATA(REQUEST("PATIENT COMMENT"))
Begin DoDot:1
+5 DO WP^SDECUTL(.PATCOMMS,$GET(REQUEST("PATIENT COMMENT")))
+6 DO WP^DIE(409.85,REQUESTIEN_",",60,"","PATCOMMS")
End DoDot:1
+7 ;
+8 IF '$GET(REQUEST("PATIENT PREFERRED START DATE",1))
QUIT
+9 ;
+10 SET NUM=0
SET COUNT=""
SET COUNT=$ORDER(REQUEST("PATIENT PREFERRED START DATE",COUNT),-1)
+11 FOR NUM=1:1:COUNT
Begin DoDot:1
+12 SET STARTDATE=$GET(REQUEST("PATIENT PREFERRED START DATE",NUM))
+13 SET ENDDATE=$GET(REQUEST("PATIENT PREFERRED END DATE",NUM))
+14 SET STARTDATE=$$ISOTFM^SDAMUTDT(STARTDATE)
SET STARTDATE=$$FMTE^XLFDT(STARTDATE)
+15 SET ENDDATE=$$ISOTFM^SDAMUTDT(ENDDATE)
SET ENDDATE=$$FMTE^XLFDT(ENDDATE)
+16 SET RANGE(NUM)="Patient preferred date range #"_NUM_": "_STARTDATE_" to "_ENDDATE
End DoDot:1
+17 DO WP^DIE(409.85,REQUESTIEN_",",60,"A","RANGE")
+18 QUIT
+19 ;
STATIONTOINST(ERRORS,STATIONNUM,INSTNAME) ;
+1 NEW INSTITUTIONIEN
+2 IF STATIONNUM=""
IF INSTNAME=""
DO ERRLOG^SDES2JSON(.ERRORS,204)
QUIT 0
+3 IF STATIONNUM=""
IF INSTNAME'=""
SET INSTITUTIONIEN=$$FIND1^DIC(4,"","X",INSTNAME,"B")
IF 'INSTITUTIONIEN
DO ERRLOG^SDES2JSON(.ERRORS,205)
QUIT 0
+4 IF STATIONNUM'=""
SET INSTITUTIONIEN=$$FIND1^DIC(4,"","X",STATIONNUM,"D")
IF 'INSTITUTIONIEN
DO ERRLOG^SDES2JSON(.ERRORS,197)
QUIT 0
+5 QUIT INSTITUTIONIEN
+6 ;
VALPRIMAMIS(ERRORS,REQUEST,FDATA) ; PRIMARY AMIS STOP CODE
+1 NEW SDPRIMAMIS,SDAMISERROR
+2 SET SDPRIMAMIS=$GET(REQUEST("PRIMARY AMIS"))
+3 SET SDAMISERROR=$$VALIDATEAMIS^SDES2UTIL(.SDPRIMAMIS,"P")
+4 IF SDAMISERROR
DO ERRLOG^SDES2JSON(.ERRORS,SDAMISERROR)
QUIT
+5 SET FDATA("PRIMARY AMIS")=SDPRIMAMIS
+6 QUIT
+7 ;
VALCREDITAMIS(ERRORS,REQUEST,FDATA) ; CREDIT AMIS STOP CODE
+1 NEW SDCREDITAMIS,SDAMISERROR
+2 SET SDCREDITAMIS=$GET(REQUEST("CREDIT AMIS"))
+3 SET SDAMISERROR=$$VALIDATEAMIS^SDES2UTIL(.SDCREDITAMIS,"C")
+4 IF SDAMISERROR
DO ERRLOG^SDES2JSON(.ERRORS,SDAMISERROR)
QUIT
+5 SET FDATA("CREDIT AMIS")=SDCREDITAMIS
+6 QUIT
+7 ;
VALIDATEDATEPREF(ERRORS,REQUEST) ;
+1 NEW ARYIEN,ARYIEN2,DATE,ERR,STARTDATE,ENDDATE
+2 SET ARYIEN=0
SET ERR=0
+3 FOR
SET ARYIEN=$ORDER(REQUEST("PATIENT PREFERRED START DATE",ARYIEN))
if 'ARYIEN!($GET(ERR))
QUIT
Begin DoDot:1
+4 SET STARTDATE=$GET(REQUEST("PATIENT PREFERRED START DATE",ARYIEN))
+5 SET STARTDATE=$$ISOTFM^SDAMUTDT(STARTDATE)
+6 IF STARTDATE=-1!($LENGTH(STARTDATE,".")=1)
SET ERR=1
DO ERRLOG^SDES2JSON(.ERRORS,206)
QUIT
+7 SET ENDDATE=$GET(REQUEST("PATIENT PREFERRED END DATE",ARYIEN))
+8 SET ENDDATE=$$ISOTFM^SDAMUTDT(ENDDATE)
+9 IF ENDDATE=-1!($LENGTH(ENDDATE,".")=1)
SET ERR=1
DO ERRLOG^SDES2JSON(.ERRORS,206)
QUIT
+10 IF ENDDATE<STARTDATE
DO ERRLOG^SDES2JSON(.ERRORS,29,"Start Date:"_STARTDATE_" - End Date: "_ENDDATE)
End DoDot:1
+11 IF $GET(REQUEST("PATIENT PREFERRED START DATE",1))
IF '$GET(REQUEST("PATIENT PREFERRED END DATE",1))
DO ERRLOG^SDES2JSON(.ERRORS,195)
QUIT
+12 IF $GET(REQUEST("PATIENT PREFERRED START DATE",2))
IF '$GET(REQUEST("PATIENT PREFERRED END DATE",2))
DO ERRLOG^SDES2JSON(.ERRORS,195)
QUIT
+13 IF $GET(REQUEST("PATIENT PREFERRED START DATE",3))
IF '$GET(REQUEST("PATIENT PREFERRED END DATE",3))
DO ERRLOG^SDES2JSON(.ERRORS,195)
QUIT
+14 IF '$GET(REQUEST("PATIENT PREFERRED START DATE",1))
IF $GET(REQUEST("PATIENT PREFERRED END DATE",1))
DO ERRLOG^SDES2JSON(.ERRORS,195)
QUIT
+15 IF '$GET(REQUEST("PATIENT PREFERRED START DATE",2))
IF $GET(REQUEST("PATIENT PREFERRED END DATE",2))
DO ERRLOG^SDES2JSON(.ERRORS,195)
QUIT
+16 IF '$GET(REQUEST("PATIENT PREFERRED START DATE",3))
IF $GET(REQUEST("PATIENT PREFERRED END DATE",3))
DO ERRLOG^SDES2JSON(.ERRORS,195)
QUIT
+17 QUIT
+18 ;
VALIDATEMRTCDATA(ERRORS,REQUEST,FILEDATA) ;
+1 NEW VRET
+2 DO VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,41,$GET(REQUEST("MRTC","NEEDED")),1,,539,208)
+3 SET FILEDATA("MRTC","NEEDED")=$GET(VRET(409.85,41,"I"))
+4 ; if this is not an mrtc, check for other mrtc fields and quit
+5 IF $GET(FILEDATA("MRTC","NEEDED"))=0
Begin DoDot:1
+6 IF $DATA(REQUEST("MRTC","PARENT REQUEST"))!($DATA(REQUEST("MRTC","DAYS BETWEEN APPTS")))!(($DATA(REQUEST("MRTC","HOW MANY NEEDED"))))
DO ERRLOG^SDES2JSON(.ERRORS,233)
End DoDot:1
QUIT
+7 ; if this is an MRTC, validate fields as required
+8 IF $GET(REQUEST("MRTC","PARENT REQUEST"))'=""
Begin DoDot:1
+9 DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),1,,536,207)
+10 IF VRET
Begin DoDot:2
+11 IF $$GET1^DIQ(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),.01,"I")'=$GET(REQUEST("DFN"))
DO ERRLOG^SDES2JSON(.ERRORS,533)
+12 IF $$GET1^DIQ(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),42,"I")'=$GET(REQUEST("MRTC","DAYS BETWEEN APPTS"))
DO ERRLOG^SDES2JSON(.ERRORS,52,"DAYS BETWEEN does not match parent.")
+13 IF $$GET1^DIQ(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),43,"I")'=$GET(REQUEST("MRTC","HOW MANY NEEDED"))
DO ERRLOG^SDES2JSON(.ERRORS,52,"HOW MANY NEEDED does not match parent.")
End DoDot:2
End DoDot:1
+14 DO VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,42,$GET(REQUEST("MRTC","DAYS BETWEEN APPTS")),1,,537,209)
+15 DO VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,43,$GET(REQUEST("MRTC","HOW MANY NEEDED")),1,,538,210)
+16 QUIT
