- 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 Jan 18, 2025@03:45:04 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