DGMSTAPI ;ALB/SCK - API's for Military Sexual Trauma ; 2/28/02 4:56pm
;;5.3;Registration;**195,243,308,353,379,443,700**;Aug 13, 1993
Q
;
GETSTAT(DFN,DGDATE) ; Retrieves the current MST status for a patient
;
; Input
; DFN - IEN of patient in the PATIENT File (#2)
; DGDATE - Date for status lookup [OPTIONAL]
;
; Output
; DGMST - Format will depend on result of lookup
;
; If an entry is found then:
; DGMST returns a 7 piece data string, caret(^)-delimited:
; $P(1) = IEN of entry in MST HISTORY File (#29.11)
; $P(2) = Internal value of MST Status ("Y,N,D,U")
; $P(3) = Date of status change
; $P(4) = IEN of provider making determination, file (#200)
; $P(5) = IEN of user who entered status, file (#200)
; $P(6) = External format of MST Status
; $P(7) = IEN pointer of the INSTITUTION file (#4)
;
; If no MST History is found, then:
; DGMST = 0^U
; "U" = (Unknown)
; If an error occured in the GETS^DIQ lookup, then:
; DGMST = -1^^Error Code IEN
; (returned by GETS^DIQ call)
;
; Get most recent MST status entry for the patient from file using
; reverse $Order on the "APDT" x-ref.
;
N DGMST,DGIEN,DGFDA,DGMSG
S DFN=$G(DFN)
I '+DFN!('$D(^DPT(DFN,0))) D G STATQ
. S DGMST="-1"
I '$D(^DGMS(29.11,"APDT",DFN)) D G STATQ
.S DGMST="0^U"
S DGDATE=$S(+$G(DGDATE)>0:DGDATE,1:$$NOW^XLFDT)
I '$D(^DGMS(29.11,"APDT",DFN,DGDATE)) S DGDATE=$$DATE(DFN,DGDATE)
I '+DGDATE D G STATQ
. S DGMST="0^U"
S DGIEN=""
S DGIEN=+$P($Q(^DGMS(29.11,"APDT",DFN,DGDATE,DGIEN),-1),",",5)
;
; Check for valid ien, if entry missing, return Unknown
I +DGIEN'>0 D G STATQ
. S DGMST="0^U"
;
; Retrieve data
D GETS^DIQ(29.11,+DGIEN_",","*","IE","DGFDA","DGMSG")
; check for errors
I $D(DGMSG) D G STATQ
.S DGMST="-1^^"_$G(DGMSG("DIERR",1))
;
S DGMST=DGIEN_U_$G(DGFDA(29.11,+DGIEN_",",3,"I"))_U_$G(DGFDA(29.11,+DGIEN_",",.01,"I"))_U_$G(DGFDA(29.11,+DGIEN_",",4,"I"))_U_$G(DGFDA(29.11,+DGIEN_",",5,"I"))
S DGMST=DGMST_U_$G(DGFDA(29.11,+DGIEN_",",3,"E"))
S DGMST=DGMST_U_$S($G(DGFDA(29.11,+DGIEN_",",6,"I"))]"":$G(DGFDA(29.11,+DGIEN_",",6,"I")),1:$$SITE)
;
STATQ Q $G(DGMST)
;
NEWSTAT(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGXMIT) ; MST HISTORY (#29.11) filer
; Callpoint to create a new MST HISTORY FILE (#29.11) entry.
; Will also queue HL7 message for HEC database updates.
;
; Input
; DFN - Patients DFN
; DGSTAT - MST Status code, "Y,N,D,U"
; DGDATE - Date of MST status change [default=NOW]
; DGPROV - IEN of Provider making determination, file (#200)
; DGSITE - IEN pointer of the INSTITUTION file (#4)
; DGXMIT - HL7 transmit flag [OPTIONAL]
; 0=don't queue a message
; 1=queue a message [default])
;
; Output
; DGRSLT - Returns IEN of file (#29.11) entry if successful
;
; If no patient was defined, then:
; DGRSLT = -1^No patient defined
;
; If an error occured in the GETS^DIQ lookup, then:
; DGMST = -1^^Error Code IEN
; (returned by GETS^DIQ call)
;
N DGFDA,DGMSG,DGERR,DGRSLT,MSTIEN
S DFN=$G(DFN)
I DFN']""!('$D(^DPT(DFN,0))) D G NEWQ
. S DGRSLT="-1^No patient defined"
;
S DGSTAT=$S($G(DGSTAT)]"":DGSTAT,1:"U")
S DGDATE=$G(DGDATE)
S DGPROV=$G(DGPROV)
S DGSITE=$G(DGSITE)
S DGXMIT=$S($G(DGXMIT)=0:DGXMIT,1:1)
S DGDATE=$S(+DGDATE>0:DGDATE,1:$$NOW^XLFDT)
S DGSITE=$S(+DGSITE>0:DGSITE,1:$$SITE)
;
I '$$CHANGE(DFN,DGSTAT,DGDATE) D G NEWQ
. S DGRSLT="0"
;
I '$$VALID(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,.DGERR) D G NEWQ
. S DGRSLT="-1^"_DGERR
;
S DGFDA(1,29.11,"+1,",.01)=DGDATE
S DGFDA(1,29.11,"+1,",2)=DFN
S DGFDA(1,29.11,"+1,",3)=DGSTAT
S DGFDA(1,29.11,"+1,",4)=DGPROV
S DGFDA(1,29.11,"+1,",5)=DUZ
S DGFDA(1,29.11,"+1,",6)=DGSITE
;
D UPDATE^DIE("","DGFDA(1)","MSTIEN","DGERR")
I $D(DGERR) D G NEWQ
. S DGRSLT="-1^"_$G(DGERR("DIERR",1))
;
S DGRSLT=+MSTIEN(1)
;
; Callpoint to queue an entry that will trigger a HEC
; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
; The HL7 message will contain the following three MST data elments
; as part of the VA-Specific Eligibility ZEL segment:
; (23) - MST STATUS
; (24) - DATE MST STATUS CHANGED
; (25) - SITE DETERMINING MST STATUS
;
I DGXMIT D
. D SEND^DGMSTL1(DFN,"Z07")
;
NEWQ Q $G(DGRSLT)
;
DELMST(MSTIEN) ; Deletes the MST HISTORY File (#29.11) entry passed in.
; This call is not to be used except from inside the DG MST List
; Manager interface.
;
; Input
; MSTIEN - IEN of the entry in the MST HISTORY File (#29.11)
;
; Output
; If no IEN passed in, return -1
; otherwise return 1
;
Q:'$G(MSTIEN) "-1^No entry to delete"
;
N DA,XD
S DA=+$G(MSTIEN)
S DIK="^DGMS(29.11,"
D ^DIK K DIK
Q 1
;
NAME(DA) ; Returns name from the VA NEW PERSON File using DIQ call
;
N DGNAME,DGPROV,DIQ,DR,DIC
I $G(DA)="" G NAMEQ
S DIC=200,DR=".01",DIQ="DGPROV"
D EN^DIQ1
S DGNAME=$G(DGPROV(200,DA,.01))
NAMEQ Q $G(DGNAME)
;
CHANGE(DFN,DGSTAT,DGDATE) ;Did the Status OR Date change?
; Input
; DFN - Patients DFN
; DGSTAT - MST Status code, "Y,N,D,U"
; DGDATE - Date of MST Status Change (FM format)
;
; Output
; Returns 0 if no status change
; 1 if status changed
;
N DGCHG,DGMST
S DGCHG=0
I +$G(DFN)'>0!('$D(^DPT(DFN,0))) G CHNGQ
S DGSTAT=$G(DGSTAT)
I DGSTAT'?1A!("YNDU"'[DGSTAT) G CHNGQ
S DGDATE=$G(DGDATE)
I DGDATE="" G CHNGQ
S DGMST=$$GETSTAT(DFN),DGMST=$G(DGMST)
I +DGMST<1!($P(DGMST,U,2)'=$G(DGSTAT))!($P(DGMST,U,3)'=$G(DGDATE)) S DGCHG=1
CHNGQ Q DGCHG
;
SITE(DGSITE) ;Convert a station number into a pointer to the
; INSTITUTION file (#4). If called with a null parameter then
; the pointer to the INSTITUTION file (#4) of the primary site
; will be returned.
;
; Input
; DGSITE - Station number (optional)
;
; Output
; Return Site IEN to INSTITUTION file (#4)
;
S DGSITE=$G(DGSITE)
I DGSITE]"",$D(^DIC(4,"D",DGSITE)) D
. S DGSITE=$O(^DIC(4,"D",DGSITE,0))
E D
. S DGSITE=$P($$SITE^VASITE,U)
I +DGSITE'>0 S DGSITE=""
Q DGSITE
;
DATE(DFN,DGDT) ;Determine 'current' MST date
;
; Input
; DFN - Patient's DFN
; DGDT - FileMan format date
;
; Output
; Return MST effective date
;
N DGMSTDT
S DFN=$G(DFN)
I '+DFN D G DATEQ
. S DGMSTDT=""
S DGDT=$S(+$G(DGDT)>0:DGDT,1:$$NOW^XLFDT)
I $P(DGDT,".",2)="" S DGDT=DGDT_".999999"
S DGMSTDT=$O(^DGMS(29.11,"APDT",DFN,DGDT),-1)
DATEQ Q DGMSTDT
;
VALID(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGERR) ;Validate fields before filing
; Input:
; DFN - [REQUIRED] - ien of Patient
; DGSTAT - [REQUIRED] - MST Status code, "Y,N,D,U"
; DGDATE - [REQUIRED] - Date of MST status change[FileMan Internal]
; DGPROV - [optional] - IEN of Provider making determination
; DGSITE - [optional] - IEN pointer of the INSTITUTION file
; DGERR - [optional] - error parameter passed by reference
; Output:
; Function Value - Returns 1 - if validation checks passed
; 0 - if validation checks failed
; DGERR - an error message if validation checks fail
; init variables
N I,DGFILE,DGFLD,DGMSG,DGSTR,DGVAL,DGVAR,DGX,VALID
S DGFILE=29.11,VALID=1,DGMSG=" IS REQUIRED"
; Quit DO block if invalid condition found
; Check for [REQUIRED] fields
D
. I DFN="" D MSG(DGFILE,2,DGMSG,.DGERR) Q ;pat ien
. I DGSTAT="" D MSG(DGFILE,3,DGMSG,.DGERR) Q ;mst status code
. I DGDATE="" D MSG(DGFILE,.01,DGMSG,.DGERR) Q ;dt chg status
.;
.; Check for valid FIELD values
. S DGMSG=" IS NOT VALID"
.; need to strip off the 'seconds' to pass the CHK^DIE() call...
. I DGDATE["." N DGSECS S DGSECS=$E($P(DGDATE,".",2),5,6) I DGSECS'="" I DGSECS<0!(DGSECS>60) D MSG(DGFILE,.01,DGMSG,.DGERR) Q
. N DGDATEX S DGDATEX=DGDATE
. I DGDATEX["." S DGDATEX=$P(DGDATEX,".")_"."_$E($P(DGDATEX,".",2),1,4)
. I $E($P(DGDATEX,".",2),1,4)="0000" S DGDATEX=$P(DGDATEX,".")_".1"
. S DGSTR=".01;DGDATEX^2;DFN^3;DGSTAT^4;DGPROV^5;DUZ^6;DGSITE"
.;
. F I=1:1:$L(DGSTR,U) S DGX=$P(DGSTR,U,I) Q:DGX="" D Q:'VALID
.. S DGFLD=$P(DGX,";"),DGVAR=$P(DGX,";",2),DGVAL=@DGVAR
.. Q:DGVAL=""
.. S VALID=$$TESTVAL(DGFILE,DGFLD,DGVAL)
.. D:'VALID MSG(DGFILE,DGFLD,DGMSG,.DGERR)
Q VALID
;
MSG(DGFIL,DGFLD,DGMSG,DGERR) ; error message setup
; Input:
; DGFIL - file number
; DGFLD - field number of file
; DGMSG - message type verbiage - " IS REQUIRED" or " IS NOT VALID"
; DGERR - error parameter passed by reference
; Output:
; DGERR - error message
S DGERR=$$GET1^DID(DGFIL,DGFLD,,"LABEL")_DGMSG
Q
;
TESTVAL(DGFIL,DGFLD,DGVAL) ; Determine if a field value is valid.
; Input:
; DGFIL - file number
; DGFLD - field number of file
; DGVAL - field value to be validated
; Output:
; Function value: Returns 1 if field is valid
; 0 if validation fails
N DGVALEX,DGRSLT,VALID
S VALID=1
I DGVAL'="" D
. S DGVALEX=$$EXTERNAL^DILFD(DGFIL,DGFLD,"F",DGVAL)
. I DGVALEX="" S VALID=0 Q ; no external value, not valid
. I $$GET1^DID(DGFIL,DGFLD,"","TYPE")'="POINTER" D
.. D CHK^DIE(DGFIL,DGFLD,,DGVALEX,.DGRSLT) I DGRSLT="^" S VALID=0
Q VALID
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMSTAPI 9457 printed Apr 09, 2024@21:51:26 Page 2
DGMSTAPI ;ALB/SCK - API's for Military Sexual Trauma ; 2/28/02 4:56pm
+1 ;;5.3;Registration;**195,243,308,353,379,443,700**;Aug 13, 1993
+2 QUIT
+3 ;
GETSTAT(DFN,DGDATE) ; Retrieves the current MST status for a patient
+1 ;
+2 ; Input
+3 ; DFN - IEN of patient in the PATIENT File (#2)
+4 ; DGDATE - Date for status lookup [OPTIONAL]
+5 ;
+6 ; Output
+7 ; DGMST - Format will depend on result of lookup
+8 ;
+9 ; If an entry is found then:
+10 ; DGMST returns a 7 piece data string, caret(^)-delimited:
+11 ; $P(1) = IEN of entry in MST HISTORY File (#29.11)
+12 ; $P(2) = Internal value of MST Status ("Y,N,D,U")
+13 ; $P(3) = Date of status change
+14 ; $P(4) = IEN of provider making determination, file (#200)
+15 ; $P(5) = IEN of user who entered status, file (#200)
+16 ; $P(6) = External format of MST Status
+17 ; $P(7) = IEN pointer of the INSTITUTION file (#4)
+18 ;
+19 ; If no MST History is found, then:
+20 ; DGMST = 0^U
+21 ; "U" = (Unknown)
+22 ; If an error occured in the GETS^DIQ lookup, then:
+23 ; DGMST = -1^^Error Code IEN
+24 ; (returned by GETS^DIQ call)
+25 ;
+26 ; Get most recent MST status entry for the patient from file using
+27 ; reverse $Order on the "APDT" x-ref.
+28 ;
+29 NEW DGMST,DGIEN,DGFDA,DGMSG
+30 SET DFN=$GET(DFN)
+31 IF '+DFN!('$DATA(^DPT(DFN,0)))
Begin DoDot:1
+32 SET DGMST="-1"
End DoDot:1
GOTO STATQ
+33 IF '$DATA(^DGMS(29.11,"APDT",DFN))
Begin DoDot:1
+34 SET DGMST="0^U"
End DoDot:1
GOTO STATQ
+35 SET DGDATE=$SELECT(+$GET(DGDATE)>0:DGDATE,1:$$NOW^XLFDT)
+36 IF '$DATA(^DGMS(29.11,"APDT",DFN,DGDATE))
SET DGDATE=$$DATE(DFN,DGDATE)
+37 IF '+DGDATE
Begin DoDot:1
+38 SET DGMST="0^U"
End DoDot:1
GOTO STATQ
+39 SET DGIEN=""
+40 SET DGIEN=+$PIECE($QUERY(^DGMS(29.11,"APDT",DFN,DGDATE,DGIEN),-1),",",5)
+41 ;
+42 ; Check for valid ien, if entry missing, return Unknown
+43 IF +DGIEN'>0
Begin DoDot:1
+44 SET DGMST="0^U"
End DoDot:1
GOTO STATQ
+45 ;
+46 ; Retrieve data
+47 DO GETS^DIQ(29.11,+DGIEN_",","*","IE","DGFDA","DGMSG")
+48 ; check for errors
+49 IF $DATA(DGMSG)
Begin DoDot:1
+50 SET DGMST="-1^^"_$GET(DGMSG("DIERR",1))
End DoDot:1
GOTO STATQ
+51 ;
+52 SET DGMST=DGIEN_U_$GET(DGFDA(29.11,+DGIEN_",",3,"I"))_U_$GET(DGFDA(29.11,+DGIEN_",",.01,"I"))_U_$GET(DGFDA(29.11,+DGIEN_",",4,"I"))_U_$GET(DGFDA(29.11,+DGIEN_",",5,"I"))
+53 SET DGMST=DGMST_U_$GET(DGFDA(29.11,+DGIEN_",",3,"E"))
+54 SET DGMST=DGMST_U_$SELECT($GET(DGFDA(29.11,+DGIEN_",",6,"I"))]"":$GET(DGFDA(29.11,+DGIEN_",",6,"I")),1:$$SITE)
+55 ;
STATQ QUIT $GET(DGMST)
+1 ;
NEWSTAT(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGXMIT) ; MST HISTORY (#29.11) filer
+1 ; Callpoint to create a new MST HISTORY FILE (#29.11) entry.
+2 ; Will also queue HL7 message for HEC database updates.
+3 ;
+4 ; Input
+5 ; DFN - Patients DFN
+6 ; DGSTAT - MST Status code, "Y,N,D,U"
+7 ; DGDATE - Date of MST status change [default=NOW]
+8 ; DGPROV - IEN of Provider making determination, file (#200)
+9 ; DGSITE - IEN pointer of the INSTITUTION file (#4)
+10 ; DGXMIT - HL7 transmit flag [OPTIONAL]
+11 ; 0=don't queue a message
+12 ; 1=queue a message [default])
+13 ;
+14 ; Output
+15 ; DGRSLT - Returns IEN of file (#29.11) entry if successful
+16 ;
+17 ; If no patient was defined, then:
+18 ; DGRSLT = -1^No patient defined
+19 ;
+20 ; If an error occured in the GETS^DIQ lookup, then:
+21 ; DGMST = -1^^Error Code IEN
+22 ; (returned by GETS^DIQ call)
+23 ;
+24 NEW DGFDA,DGMSG,DGERR,DGRSLT,MSTIEN
+25 SET DFN=$GET(DFN)
+26 IF DFN']""!('$DATA(^DPT(DFN,0)))
Begin DoDot:1
+27 SET DGRSLT="-1^No patient defined"
End DoDot:1
GOTO NEWQ
+28 ;
+29 SET DGSTAT=$SELECT($GET(DGSTAT)]"":DGSTAT,1:"U")
+30 SET DGDATE=$GET(DGDATE)
+31 SET DGPROV=$GET(DGPROV)
+32 SET DGSITE=$GET(DGSITE)
+33 SET DGXMIT=$SELECT($GET(DGXMIT)=0:DGXMIT,1:1)
+34 SET DGDATE=$SELECT(+DGDATE>0:DGDATE,1:$$NOW^XLFDT)
+35 SET DGSITE=$SELECT(+DGSITE>0:DGSITE,1:$$SITE)
+36 ;
+37 IF '$$CHANGE(DFN,DGSTAT,DGDATE)
Begin DoDot:1
+38 SET DGRSLT="0"
End DoDot:1
GOTO NEWQ
+39 ;
+40 IF '$$VALID(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,.DGERR)
Begin DoDot:1
+41 SET DGRSLT="-1^"_DGERR
End DoDot:1
GOTO NEWQ
+42 ;
+43 SET DGFDA(1,29.11,"+1,",.01)=DGDATE
+44 SET DGFDA(1,29.11,"+1,",2)=DFN
+45 SET DGFDA(1,29.11,"+1,",3)=DGSTAT
+46 SET DGFDA(1,29.11,"+1,",4)=DGPROV
+47 SET DGFDA(1,29.11,"+1,",5)=DUZ
+48 SET DGFDA(1,29.11,"+1,",6)=DGSITE
+49 ;
+50 DO UPDATE^DIE("","DGFDA(1)","MSTIEN","DGERR")
+51 IF $DATA(DGERR)
Begin DoDot:1
+52 SET DGRSLT="-1^"_$GET(DGERR("DIERR",1))
End DoDot:1
GOTO NEWQ
+53 ;
+54 SET DGRSLT=+MSTIEN(1)
+55 ;
+56 ; Callpoint to queue an entry that will trigger a HEC
+57 ; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
+58 ; The HL7 message will contain the following three MST data elments
+59 ; as part of the VA-Specific Eligibility ZEL segment:
+60 ; (23) - MST STATUS
+61 ; (24) - DATE MST STATUS CHANGED
+62 ; (25) - SITE DETERMINING MST STATUS
+63 ;
+64 IF DGXMIT
Begin DoDot:1
+65 DO SEND^DGMSTL1(DFN,"Z07")
End DoDot:1
+66 ;
NEWQ QUIT $GET(DGRSLT)
+1 ;
DELMST(MSTIEN) ; Deletes the MST HISTORY File (#29.11) entry passed in.
+1 ; This call is not to be used except from inside the DG MST List
+2 ; Manager interface.
+3 ;
+4 ; Input
+5 ; MSTIEN - IEN of the entry in the MST HISTORY File (#29.11)
+6 ;
+7 ; Output
+8 ; If no IEN passed in, return -1
+9 ; otherwise return 1
+10 ;
+11 if '$GET(MSTIEN)
QUIT "-1^No entry to delete"
+12 ;
+13 NEW DA,XD
+14 SET DA=+$GET(MSTIEN)
+15 SET DIK="^DGMS(29.11,"
+16 DO ^DIK
KILL DIK
+17 QUIT 1
+18 ;
NAME(DA) ; Returns name from the VA NEW PERSON File using DIQ call
+1 ;
+2 NEW DGNAME,DGPROV,DIQ,DR,DIC
+3 IF $GET(DA)=""
GOTO NAMEQ
+4 SET DIC=200
SET DR=".01"
SET DIQ="DGPROV"
+5 DO EN^DIQ1
+6 SET DGNAME=$GET(DGPROV(200,DA,.01))
NAMEQ QUIT $GET(DGNAME)
+1 ;
CHANGE(DFN,DGSTAT,DGDATE) ;Did the Status OR Date change?
+1 ; Input
+2 ; DFN - Patients DFN
+3 ; DGSTAT - MST Status code, "Y,N,D,U"
+4 ; DGDATE - Date of MST Status Change (FM format)
+5 ;
+6 ; Output
+7 ; Returns 0 if no status change
+8 ; 1 if status changed
+9 ;
+10 NEW DGCHG,DGMST
+11 SET DGCHG=0
+12 IF +$GET(DFN)'>0!('$DATA(^DPT(DFN,0)))
GOTO CHNGQ
+13 SET DGSTAT=$GET(DGSTAT)
+14 IF DGSTAT'?1A!("YNDU"'[DGSTAT)
GOTO CHNGQ
+15 SET DGDATE=$GET(DGDATE)
+16 IF DGDATE=""
GOTO CHNGQ
+17 SET DGMST=$$GETSTAT(DFN)
SET DGMST=$GET(DGMST)
+18 IF +DGMST<1!($PIECE(DGMST,U,2)'=$GET(DGSTAT))!($PIECE(DGMST,U,3)'=$GET(DGDATE))
SET DGCHG=1
CHNGQ QUIT DGCHG
+1 ;
SITE(DGSITE) ;Convert a station number into a pointer to the
+1 ; INSTITUTION file (#4). If called with a null parameter then
+2 ; the pointer to the INSTITUTION file (#4) of the primary site
+3 ; will be returned.
+4 ;
+5 ; Input
+6 ; DGSITE - Station number (optional)
+7 ;
+8 ; Output
+9 ; Return Site IEN to INSTITUTION file (#4)
+10 ;
+11 SET DGSITE=$GET(DGSITE)
+12 IF DGSITE]""
IF $DATA(^DIC(4,"D",DGSITE))
Begin DoDot:1
+13 SET DGSITE=$ORDER(^DIC(4,"D",DGSITE,0))
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET DGSITE=$PIECE($$SITE^VASITE,U)
End DoDot:1
+16 IF +DGSITE'>0
SET DGSITE=""
+17 QUIT DGSITE
+18 ;
DATE(DFN,DGDT) ;Determine 'current' MST date
+1 ;
+2 ; Input
+3 ; DFN - Patient's DFN
+4 ; DGDT - FileMan format date
+5 ;
+6 ; Output
+7 ; Return MST effective date
+8 ;
+9 NEW DGMSTDT
+10 SET DFN=$GET(DFN)
+11 IF '+DFN
Begin DoDot:1
+12 SET DGMSTDT=""
End DoDot:1
GOTO DATEQ
+13 SET DGDT=$SELECT(+$GET(DGDT)>0:DGDT,1:$$NOW^XLFDT)
+14 IF $PIECE(DGDT,".",2)=""
SET DGDT=DGDT_".999999"
+15 SET DGMSTDT=$ORDER(^DGMS(29.11,"APDT",DFN,DGDT),-1)
DATEQ QUIT DGMSTDT
+1 ;
VALID(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGERR) ;Validate fields before filing
+1 ; Input:
+2 ; DFN - [REQUIRED] - ien of Patient
+3 ; DGSTAT - [REQUIRED] - MST Status code, "Y,N,D,U"
+4 ; DGDATE - [REQUIRED] - Date of MST status change[FileMan Internal]
+5 ; DGPROV - [optional] - IEN of Provider making determination
+6 ; DGSITE - [optional] - IEN pointer of the INSTITUTION file
+7 ; DGERR - [optional] - error parameter passed by reference
+8 ; Output:
+9 ; Function Value - Returns 1 - if validation checks passed
+10 ; 0 - if validation checks failed
+11 ; DGERR - an error message if validation checks fail
+12 ; init variables
+13 NEW I,DGFILE,DGFLD,DGMSG,DGSTR,DGVAL,DGVAR,DGX,VALID
+14 SET DGFILE=29.11
SET VALID=1
SET DGMSG=" IS REQUIRED"
+15 ; Quit DO block if invalid condition found
+16 ; Check for [REQUIRED] fields
+17 Begin DoDot:1
+18 ;pat ien
IF DFN=""
DO MSG(DGFILE,2,DGMSG,.DGERR)
QUIT
+19 ;mst status code
IF DGSTAT=""
DO MSG(DGFILE,3,DGMSG,.DGERR)
QUIT
+20 ;dt chg status
IF DGDATE=""
DO MSG(DGFILE,.01,DGMSG,.DGERR)
QUIT
+21 ;
+22 ; Check for valid FIELD values
+23 SET DGMSG=" IS NOT VALID"
+24 ; need to strip off the 'seconds' to pass the CHK^DIE() call...
+25 IF DGDATE["."
NEW DGSECS
SET DGSECS=$EXTRACT($PIECE(DGDATE,".",2),5,6)
IF DGSECS'=""
IF DGSECS<0!(DGSECS>60)
DO MSG(DGFILE,.01,DGMSG,.DGERR)
QUIT
+26 NEW DGDATEX
SET DGDATEX=DGDATE
+27 IF DGDATEX["."
SET DGDATEX=$PIECE(DGDATEX,".")_"."_$EXTRACT($PIECE(DGDATEX,".",2),1,4)
+28 IF $EXTRACT($PIECE(DGDATEX,".",2),1,4)="0000"
SET DGDATEX=$PIECE(DGDATEX,".")_".1"
+29 SET DGSTR=".01;DGDATEX^2;DFN^3;DGSTAT^4;DGPROV^5;DUZ^6;DGSITE"
+30 ;
+31 FOR I=1:1:$LENGTH(DGSTR,U)
SET DGX=$PIECE(DGSTR,U,I)
if DGX=""
QUIT
Begin DoDot:2
+32 SET DGFLD=$PIECE(DGX,";")
SET DGVAR=$PIECE(DGX,";",2)
SET DGVAL=@DGVAR
+33 if DGVAL=""
QUIT
+34 SET VALID=$$TESTVAL(DGFILE,DGFLD,DGVAL)
+35 if 'VALID
DO MSG(DGFILE,DGFLD,DGMSG,.DGERR)
End DoDot:2
if 'VALID
QUIT
End DoDot:1
+36 QUIT VALID
+37 ;
MSG(DGFIL,DGFLD,DGMSG,DGERR) ; error message setup
+1 ; Input:
+2 ; DGFIL - file number
+3 ; DGFLD - field number of file
+4 ; DGMSG - message type verbiage - " IS REQUIRED" or " IS NOT VALID"
+5 ; DGERR - error parameter passed by reference
+6 ; Output:
+7 ; DGERR - error message
+8 SET DGERR=$$GET1^DID(DGFIL,DGFLD,,"LABEL")_DGMSG
+9 QUIT
+10 ;
TESTVAL(DGFIL,DGFLD,DGVAL) ; Determine if a field value is valid.
+1 ; Input:
+2 ; DGFIL - file number
+3 ; DGFLD - field number of file
+4 ; DGVAL - field value to be validated
+5 ; Output:
+6 ; Function value: Returns 1 if field is valid
+7 ; 0 if validation fails
+8 NEW DGVALEX,DGRSLT,VALID
+9 SET VALID=1
+10 IF DGVAL'=""
Begin DoDot:1
+11 SET DGVALEX=$$EXTERNAL^DILFD(DGFIL,DGFLD,"F",DGVAL)
+12 ; no external value, not valid
IF DGVALEX=""
SET VALID=0
QUIT
+13 IF $$GET1^DID(DGFIL,DGFLD,"","TYPE")'="POINTER"
Begin DoDot:2
+14 DO CHK^DIE(DGFIL,DGFLD,,DGVALEX,.DGRSLT)
IF DGRSLT="^"
SET VALID=0
End DoDot:2
End DoDot:1
+15 QUIT VALID
