DGOTHBT2 ;SLC/SS,JC - OTH AND PP APIs ; 09/22/2020
;;5.3;Registration;**1029,1035,1047,1100,1126**;Aug 13, 1993;Build 3
;ICRs: $$INSUR^IBBAPI - DBIA4419
;* Returns Category I PRF information
;Input:
; DGDFN - IEN in the file (#2)
;Output:
; Piece #1:
; "Y" patient has at least one Category I PRF flag
; "N" patient does not have any Category I PRF flags
; Piece #2:
; "A" patient has at least one active PRF
; "" patient does not have any active PRF flags
; Piece #3:
; "I" patient has at least one inactive PRF
; "" patient does not have any inactive PRF flags
; DGRET - subscript for ^TMP($J,DGRET,DFN)array to return data from $$GETALL^DGPFAA
;Example of the returned value:
; Y^A - if only one active flag
; Y^^I - if only one inactive flag
; Y^A^I - if have both active and inactive flag
; N - if there are no PRF flags
;Example of the array:
;PRFARR("A","BEHAVIORAL")=123
;PRFARR("A","HIGH RISK FOR SUICIDE")=121
;PRFARR("I","MISSING PATIENT")=122
;
PRFINFO(DGDFN,DGRETGL) ;
N DGIENS,DGIEN,DGARR,DGRETVL,DGIEN2,DGRET2,DGFLSARR,DGRET,DGEIECHK
K DGRET
S DGRETVL="N"
K ^TMP($J,DGRETGL,DGDFN)
; get all assignment ien's for the patient for
; - both active and inactive flags, the 3rd parameter = ""
; - only Category I (national flag), the 4th parameter = 1
;Selected patient has no record flag assignments on file.
I '$$GETALL^DGPFAA(DGDFN,.DGRET2,"",1) Q DGRETVL
;check what statuses we have at the moment for each flag and set the return value's pieces accordingly
S DGIEN="" F S DGIEN=$O(DGRET2(DGIEN)) Q:DGIEN="" D
. S DGEIECHK=$$CHECKEIE(DGIEN)
. I DGEIECHK Q
. K DGARR
. S DGIEN2=DGIEN_","
. D GETS^DIQ(26.13,DGIEN2,".02;.03","IE","DGARR")
. I $G(DGARR(26.13,DGIEN2,.03,"E"))="ACTIVE" S DGRET("A",$G(DGARR(26.13,DGIEN2,.02,"E")))=DGIEN,$P(DGRETVL,U,2)="A",$P(DGRETVL,U,1)="Y"
. E I $G(DGARR(26.13,DGIEN2,.03,"E"))="INACTIVE" S DGRET("I",$G(DGARR(26.13,DGIEN2,.02,"E")))=DGIEN,$P(DGRETVL,U,3)="I",$P(DGRETVL,U,1)="Y"
M ^TMP($J,DGRETGL,DGDFN)=DGRET
;add all other related information about the flags, its history and patient data to the ^TMP
D:$P(DGRETVL,U,3)="I" PRFAPI(DGDFN,DGRETGL,"I")
D:$P(DGRETVL,U,2)="A" PRFAPI(DGDFN,DGRETGL,"A")
Q DGRETVL
;
CHECKEIE(DGIEN) ;
N DGBX,DGCDGPF,DGSFLAG,DGEIE,DGBXP,DGBXPFLAG,DGBXPF
S DGBX=0,DGEIE=0
F S DGBX=$O(^DGPF(26.14,"B",DGIEN,DGBX)) Q:DGBX="" D
. S DGCDGPF=$G(^DGPF(26.14,DGBX,0))
. S DGSFLAG=$P(DGCDGPF,U,3)
. Q:DGSFLAG'=5
. S DGEIE=1,DGBXP=$O(^DGPF(26.14,"B",DGIEN,DGBX),-1)
. S DGBXPF=$G(^DGPF(26.14,DGBXP,0))
. S DGBXPFLAG=$P(DGBXPF,U,3)
. I DGBXPFLAG'=1 S DGEIE=0
Q DGEIE
;
PRFAPI(DGDFN,DGRETGL,DGACT) ;
N DGARFLAG,DGIEN,DGPRFFL,DGARRHS
S DGPRFFL="" F S DGPRFFL=$O(^TMP($J,DGRETGL,DGDFN,DGACT,DGPRFFL)) Q:DGPRFFL="" S DGIEN=+$G(^TMP($J,DGRETGL,DGDFN,DGACT,DGPRFFL)) I DGIEN>0 K DGARFLAG I $$GETASGN^DGPFAA(DGIEN,.DGARFLAG) D
. M ^TMP($J,DGRETGL,DGDFN,DGACT,DGPRFFL,"D")=DGARFLAG
. K DGARRHS D GETHIST(DGIEN,.DGARRHS)
. M ^TMP($J,DGRETGL,DGDFN,DGACT,DGPRFFL,"H")=DGARRHS
Q
;
;Get history
;Input:
; DGIEN13 - IEN of #26.14
; DGACT - "A" for active, "I" for inactive
; DGPRFFL - full name of the flag (MISSING PATIENT, BEHAVIORAL or HIGH RISK FOR SUICIDE)
; DGARRFL - array to return (merge with)
GETHIST(DGIEN13,DGARRFL) ;
N DGIEN14,DGDTTM,DGIENS,DGARRH
I '$$GETALLDT^DGPFAAH(DGIEN13,.DGIENS) Q
S DGDTTM="" F S DGDTTM=$O(DGIENS(DGDTTM)) Q:+DGDTTM=0 S DGIEN14=$G(DGIENS(DGDTTM)) I DGIEN14 D
. K DGARRH
. I $$GETHIST^DGPFAAH(DGIEN14,.DGARRH,1) M DGARRFL(DGDTTM)=DGARRH
Q
;show inactive PRF only
; Inactive Flag (non-OTH, non-PP, but has inactive HRFS and/or MISSING PATIENT PRF(s)) -> "Inactive Flag"
; Note: "BEHAVIORAL" should not be displayed according requirements
;Input:
; PRFARR - returned by S PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,.PRFARR)
; RET - local array to return information to send back to CPRS
;Output:
; RET - local array to return information to send back to CPRS
;Example:DGPFAPIH
INPRFONL(DGDFN,PRFTMP,RET) ;
N DGFLIEN1,DGFLIEN2,DGCNT,DGRECN,DGMXHRFS
N NUMHRFS,NUMMISS
S (NUMHRFS,NUMMISS)=0
S RET(0)=0
S DGFLIEN1=+$G(^TMP($J,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
S DGFLIEN2=+$G(^TMP($J,PRFTMP,DGDFN,"I","MISSING PATIENT"))
I 'DGFLIEN1,'DGFLIEN2 Q
I DGFLIEN1 S NUMHRFS=$$HISTLEN(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE")
I DGFLIEN2 S NUMMISS=$$HISTLEN(PRFTMP,DGDFN,"I","MISSING PATIENT")
D HISTRECS("N",.NUMHRFS,.NUMMISS) ;
D ADDLINE(.RET,"Inactive Flag^Patient has Inactive Flag(s), click to view")
D ADDLINE(.RET," ")
I DGFLIEN1 D SETHRFS(.RET,PRFTMP,DGDFN,NUMHRFS)
I DGFLIEN1 D ADDLINE(.RET," ")
I DGFLIEN2 D SETMISP(.RET,PRFTMP,DGDFN,NUMMISS)
Q
;set header and history for HRfS
;RET to set array for CPRS
;PRFTMP - subscript in the TMP global
;DGHISNUM - number of history records to show
; - if patient has both HRfS and MISSING flags
; then HRfS will be shown first but we need to save a space for MISSING as well
; therefore we have to show fewer history entries for HRfS i.e. just 1 entry
; - if patient has only one HRfS flag then we show 2 entries
SETHRFS(RET,PRFTMP,DGDFN,DGHISNUM) ;
D ADDLINE(.RET,"Flag name: HIGH RISK FOR SUICIDE Status: INACTIVE")
D ADDLINE(.RET," Initial Assigned Date: "_$$FLGASSDT(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
D ADDLINE(.RET," Originating Site: "_$$FORGSITE(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
D ADDLINE(.RET," Owner Site: "_$$FLOWNSITE(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
D ADDHIST(.RET,PRFTMP,DGDFN,"HIGH RISK FOR SUICIDE","I",DGHISNUM)
Q
;return FLG ASSIG DATE
;parameters: DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM
FLGASSDT(DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM) ;
N DG2613,DGDTTM
S DGDTTM=0
S DG2613=$G(^TMP($J,DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM))
I DG2613 S DGDTTM=+$$GETADT^DGPFAAH(DG2613)
I DGDTTM>0 Q $$DATETM(DGDTTM)
Q "UNKNOWN"
;
FORGSITE(DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM) ;return FLG SITE
Q $P($G(^TMP($J,DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM,"D","ORIGSITE")),U,2)
;
FLOWNSITE(DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM) ;return flag owner site
Q $P($G(^TMP($J,DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM,"D","OWNER")),U,2)
;
;return ARR array with DGNUM of history entries
;RET to set array for CPRS
;PRFTMP - subscript in the TMP global
;DGHISNUM - number of history records to show
ADDHIST(RET,PRFTMP,DGDFN,DGFLAG,DGSTAT,DGNUM) ;
N DGCNT,DGDTTM,DGACTION,DGSITE,DGMOREHI,DGZ,DGPRSITE,DGDTTIME
S DGPRSITE=""
S DGDTTM=99999999,DGCNT=0,DGMOREHI=0
F S DGDTTM=$O(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM),-1) Q:+DGDTTM=0!(DGCNT'<DGNUM) D
. S DGACTION=$P($G(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ACTION")),U,2)
. ;if not one of them then don't use (don't display)
. S DGZ="^"_DGACTION_"^"
. I "^INACTIVATE^REACTIVATE^CONTINUE^"'[DGZ Q
. S DGSITE=$G(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ORIGFAC"))
. S DGDTTIME=$G(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ASSIGNDT"))
. I DGPRSITE'=$P(DGSITE,U,2) D ADDLINE(.RET," "_$P(DGSITE,U,2)_" changes:")
. D ADDLINE(.RET," DATE/TIME: "_$P(DGDTTIME,U,2)_" ACTION: "_DGACTION)
. S DGPRSITE=$P(DGSITE,U,2)
. S DGCNT=DGCNT+1
;are there are more items to show?
I $$IFMORE(PRFTMP,DGDFN,DGSTAT,DGFLAG,DGDTTM)>0 D ADDLINE(.RET," *****additional info is in vista*****")
Q
;
;check is we have more entries with INACTIVATE,REACTIVATE and CONTINUE to display
IFMORE(PRFTMP,DGDFN,DGSTAT,DGFLAG,DGDTTM) ;
N DGZ,DGFND
S DGDTTM=DGDTTM+.00000000001
S DGFND=0
F S DGDTTM=$O(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM),-1) Q:+DGDTTM=0!(DGFND>0) D
. S DGACTION=$P($G(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ACTION")),U,2)
. ;if not one of them then don't use (don't display)
. S DGZ="^"_DGACTION_"^"
. I "^INACTIVATE^REACTIVATE^CONTINUE^"[DGZ S DGFND=1
Q DGFND
;
;/**
;set header and history for MISSING PATIENT
;RET to set array for CPRS
;PRFTMP - subscript in the TMP global
;*/
SETMISP(RET,PRFTMP,DGDFN,DGHISNUM) ;
D ADDLINE(.RET,"Flag name: MISSING PATIENT Status: INACTIVE")
D ADDLINE(.RET," Initial Assigned Date: "_$$FLGASSDT(PRFTMP,DGDFN,"I","MISSING PATIENT"))
D ADDLINE(.RET," Originating Site: "_$$FORGSITE(PRFTMP,DGDFN,"I","MISSING PATIENT"))
D ADDLINE(.RET," Owner Site: "_$$FLOWNSITE(PRFTMP,DGDFN,"I","MISSING PATIENT"))
D ADDHIST(.RET,PRFTMP,DGDFN,"MISSING PATIENT","I",DGHISNUM)
Q
;show OTH + PRF
;Input:
; DGEXP - OTH data from $$GETEXPR^DGOTHD(DGDFN)
; PRFTMP - subscript to ^TMP($J,PRFTMP) with PRF data
; RET - to return an array with data
;Output:
; RET(0)=0 - nothing to display
;or
; RET(0)>0, RET - with data to display on the button
OTHINPRF(DGDFN,DGEXP,PRFTMP,RET) ;
N DGOTHTYP
S RET(0)=0
;determine the OTH type
S DGOTHTYP=$$ISOTH^DGOTHD(DGEXP)
;if OTH-EXT
;Button label:
; OTH and Inactive Flag (OTH EXT and has inactive HRFS and/or MISSING PATIENT PRF(s)) "OTH/Inactive Flag"
; OTH-EXT and Inactive Flag:
;Button Hover text 1st line: 'Other than Honorable, click for details'
;Button Hover text 2nd line: 'Patient has Inactive Flag(s), click to view'
I DGOTHTYP=1 D Q
.S RET(0)=11
.S RET(1)="OTH-EXT^Other than Honorable, click for details"
.S RET(2)="Inactive Flag^Patient has Inactive Flag(s), click to view"
.S RET(3)="Other than Honorable - Extended"
.S RET(4)=" "
.S RET(5)="Eligible for Mental Health care only unless Veteran has positive MST screen."
.S RET(6)=" "
.S RET(7)="If MST Screen is positive, Veteran is eligible for MST related mental health and medical care."
.S RET(8)="Please review MST checkbox or complete MST screening."
.S RET(9)=" "
.S RET(10)="Not time limited - pending VBA adjudication."
.S RET(11)="Adjudication will determine eligibility for continuing care."
.D PRWTHOTH(DGDFN,"DGPRINFO",.RET)
.Q
;if OTH-90
;Button label:
; OTH-90 and Inactive Flag (OTH-90 and has inactive HRFS and/or MISSING PATIENT PRF(s)) "OTH/Inactive Flag"
; OTH and Inactive Flag
;1st line on button hover text: 'Other Than Honorable, click for details'
;2nd line on button hover text: 'Patient has Inactive Flag(s), click to view'
I DGOTHTYP=2 D Q
.D OTH90^DGOTHBTN(DGDFN,.RET)
.;overwrite label and hover text
.S RET(1)="OTH-90^Other than Honorable, click for details"
.S RET(2)="Inactive Flag^Patient has Inactive Flag(s), click to view"
.D PRWTHOTH(DGDFN,"DGPRINFO",.RET)
Q
;show inactive PRF with OTH
; Note: "BEHAVIORAL" should not be displayed according requirements
;Input:
; PRFARR - returned by S PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,.PRFARR)
; RET - local array to return information to send back to CPRS
;Output:
; RET - local array to return information to send back to CPRS
;Example:DGPFAPIH
PRWTHOTH(DGDFN,PRFTMP,RET) ;
N DGFLIEN1,DGFLIEN2,DGCNT,DGRECN,DGMXHRFS
N NUMHRFS,NUMMISS
S (NUMHRFS,NUMMISS)=0
S DGFLIEN1=+$G(^TMP($J,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
S DGFLIEN2=+$G(^TMP($J,PRFTMP,DGDFN,"I","MISSING PATIENT"))
I DGFLIEN1 S NUMHRFS=$$HISTLEN(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE")
I DGFLIEN2 S NUMMISS=$$HISTLEN(PRFTMP,DGDFN,"I","MISSING PATIENT")
D HISTRECS("O",.NUMHRFS,.NUMMISS) ;
D ADDLINE(.RET," ")
I DGFLIEN1 D SETHRFS(.RET,PRFTMP,DGDFN,NUMHRFS)
I DGFLIEN1 D ADDLINE(.RET," ")
I DGFLIEN2 D SETMISP(.RET,PRFTMP,DGDFN,NUMMISS)
Q
;
;/**
;show inactive PRF with PP
; Note: "BEHAVIORAL" should not be displayed according requirements
;Input:
; PRFARR - returned by S PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,.PRFARR)
; RET - local array to return information to send back to CPRS
;Output:
; RET - local array to return information to send back to CPRS
;
;Example:DGPFAPIH
;
;*/
PRWITHPP(DGDFN,PRFTMP,RET) ;
N DGFLIEN1,DGFLIEN2,DGCNT,DGRECN,DGMXHRFS
N NUMHRFS,NUMMISS
S (NUMHRFS,NUMMISS)=0
S DGFLIEN1=+$G(^TMP($J,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
S DGFLIEN2=+$G(^TMP($J,PRFTMP,DGDFN,"I","MISSING PATIENT"))
I DGFLIEN1 S NUMHRFS=$$HISTLEN(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE")
I DGFLIEN2 S NUMMISS=$$HISTLEN(PRFTMP,DGDFN,"I","MISSING PATIENT")
D HISTRECS("P",.NUMHRFS,.NUMMISS) ;
D ADDLINE(.RET,"Inactive Flag^Patient has Inactive Flag(s), click to view") ;DG*5.3*1100 ensures the RET array is setup correctly
D ADDLINE(.RET," ")
I DGFLIEN1 D SETHRFS(.RET,PRFTMP,DGDFN,NUMHRFS)
I DGFLIEN1 D ADDLINE(.RET," ")
I DGFLIEN2 D SETMISP(.RET,PRFTMP,DGDFN,NUMMISS)
Q
;
;/** Check if any mailman message was already sent today and send the MailMan message for this patient
;Input parameters:
;*/
SENDMAIL(DGDFN) ;
N DGSENTON
;get the date when the message was sent last time (if we have a record for this)
S DGSENTON=$$MMSENTON(DGDFN)
;if there is no any ^XTM record about last mailman message then MailMan message can be sent now and create the ^XTMP global entry
I DGSENTON=0 D COMPSEND(DGDFN) Q
;if the date MM was sent last time is the same as today then do not sent message
I DGSENTON=DT Q
;if the date MM was sent last time on a different day then send the message and update the ^XTMP global entry
D COMPSEND(DGDFN)
Q
;
COMPSEND(DGDFN) ;Compose the message that notifies the Registration users added to the DGEN ELIGIBILITY ALERT group
N DGMSG
;send email
D COMPMSG(DGDFN,.DGMSG)
D SENDMSG(.DGMSG,"Presumptive Psychosis information needed")
D SETXTMP(DGDFN)
Q
;Compose the message that notifies the Registration users added to the DGEN ELIGIBILITY ALERT group
;that PP workaround settings are not completed for the patient
;Input parameters:
;the mockup of the message sent to the DGEN ELIGIBILITY ALERT mail group:
;The following patient has PRESUMED PSYCHOSIS indicated,but all fields have not
;been completed to support this. All fields must be completed in order for this
;patient to be eligible for treatment under the Presumed Psychosis Program.
;
;Required Fields: Screen 7, Field 3
; Screen 11, Field 4
;
;PATIENT NAME: ZZTEST,PRESUMED PSYCHOSIS
; Last 4 SSN: 1234
COMPMSG(DGDFN,DGMSG) ;
N DGNAME,DGSSN,DGPAT,DGDFN1
S DGDFN1=DGDFN_","
D GETS^DIQ(2,DGDFN1,".01;.09","EI","DGPAT") I '$D(DGPAT) Q
S DGSSN=DGPAT(2,DGDFN1,.09,"E")
S DGNAME=DGPAT(2,DGDFN1,.01,"E")
S DGMSG(1)="The following patient has PRESUMED PSYCHOSIS indicated,but all fields have not"
S DGMSG(2)="been completed to support this. All fields must be completed in order for this"
S DGMSG(3)="patient to be eligible for treatment under the Presumed Psychosis Program."
S DGMSG(4)=" "
S DGMSG(5)="Required Fields: Screen 7, Field 3"
S DGMSG(6)=" Screen 11, Field 4"
S DGMSG(7)="PATIENT NAME: "_DGNAME
S DGMSG(8)=" Last 4 SSN: "_$E(DGSSN,$L(DGSSN)-3,$L(DGSSN))
Q
;
;/** Send MailMan message to DGEN ELIGIBILITY ALERT group
;Input parameters:
; DGMSG - array with the text
; DGSUBJ - mailman subject
;*/
SENDMSG(DGMSG,DGSUBJ) ;
N XMDUZ,XMTEXT,XMY,XMSUB
S XMSUB=DGSUBJ
S XMDUZ="POSTMASTER",XMTEXT="DGMSG(",XMY("G.DGEN ELIGIBILITY ALERT@"_^XMB("NETNAME"))=""
D ^XMD ; Returns: XMZ(if no error),XMMG(if error)
Q
;
;/**
;mailman was sent last time on the date?
;Input parameters:
;output parameters:
; returns
; 0 - there is no any ^XTM record about last mailman message (which means message can be sent now)
; 1 - the date when the message was sent last time
;*/
MMSENTON(DGDFN) ;
N DGVAL
S DGVAL=$G(^XTMP("DGPPMSGFOR"_DGDFN,0))
I +DGVAL=0 Q 0
Q $P(DGVAL,U,2)
;
;/** Set ^XTMP entry so we can check for it and prevent sending the mailman message more than once a day
;Input parameters:
;*/
SETXTMP(DGDFN) ;
N DGPURGE,DGNODE
S DGPURGE=$$FMADD^XLFDT(DT,1)
S DGNODE="DGPPMSGFOR"_DGDFN
S ^XTMP(DGNODE,0)=DGPURGE_U_DT_U_"DG PP MSG WAS SENT"
Q
;
;/**add lines to the CPRS array RET
; RET - the local array by reference
; DGTEXT - text to add
;*/
ADDLINE(RET,DGTEXT) ;
S RET(0)=$G(RET(0))+1
S RET(RET(0))=DGTEXT
Q
;
;FM date to MON DD, YYYY@HH:MM
DATETM(Y) ;
D DD^%DT W Y
Q Y
;
;/*
;returns number of records in the PRF history
;Note: will count only INACTIVATE,REACTIVATE,CONTINUE
;PRFTMP - subscript in the TMP global
;DGSTAT - status ("A" or "I")
;DGFLAG - full flag name
;*/
HISTLEN(PRFTMP,DGDFN,DGSTAT,DGFLAG) ;
N DGCNT,DGDTTM,DGZ,DGACTION
S DGCNT=0,DGDTTM=""
F S DGDTTM=$O(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM)) Q:+DGDTTM=0 D
. S DGACTION=$P($G(^TMP($J,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ACTION")),U,2)
. ;if not one of the three below then don't count and don't use (don't display)
. S DGZ="^"_DGACTION_"^"
. I "^INACTIVATE^REACTIVATE^CONTINUE^"'[DGZ Q
. S DGCNT=DGCNT+1
Q DGCNT
;
;Calculate max number of history records to display for HRfS and MISSING if
; we have PP
; OTH
; and when we don't have any of PP or OTH
;
;this number depends on the number of history records for each HRFS and MISSING we found for the patient
;
;Note: HRFS always displayed first, then MISSING
; MISSING should display at least one history record
;
;Parameters:
; DGPPOTH - "P" if patient has PP
; "O" if patient has OTH
; "N" if patient does not have OTH and PP
; NUMHRFS - number of history records for HRfS , passed by reference so it will be adjusted accordingly
; NUMMISS - number of history records for MISSING , passed by reference so it will be adjusted accordingly
;
HISTRECS(DGPPOTH,NUMHRFS,NUMMISS) ;
N MXPRFONL
S MXPRFONL=6 ;MAX number of records in total if not OTH and no PP, just PRF
;if not OTH and no PP
I DGPPOTH="P" S MXPRFONL=5 ;to allow the space for PP info
I DGPPOTH="O" S MXPRFONL=5 ;to allow the space for OTH info
;if we have only MISSING then set to MAX and it will display all entries less than MAX or upto MAX in ADDHIST function
I NUMHRFS=0 S NUMMISS=MXPRFONL Q
;if we have only HRfS then set to MAX and it will display all entries less than MAX or upto MAX in ADDHIST function
I NUMMISS=0 S NUMHRFS=MXPRFONL Q
;now if we have both HRfS and MISSING ...
;
;if total number of records is less than MAX ( "less then < MXPRFONL" because generic info for the MISSING will take some space too)
;and leave all as is - ADDHIST function will display all entries for each
;example: NUMHRFS=4,NUMMISS=1 or NUMHRFS=1,NUMMISS=4 or NUMHRFS=3,NUMMISS=2
I (NUMHRFS+NUMMISS)<MXPRFONL Q
;if total number of HRFS history entries no less than MXPRFONL-1 (because generic info for the MISSING will take some space too)
;example: NUMHRFS=5,NUMMISS=1 or NUMHRFS=7,NUMMISS=8
I NUMHRFS'<(MXPRFONL-1) S NUMHRFS=MXPRFONL-2,NUMMISS=1
;if total number of HRFS history entries less than MXPRFONL-1 (because generic info for the MISSING will take some space too)
;example: NUMHRFS=4,NUMMISS=1 or NUMHRFS=3,NUMMISS=8
I NUMHRFS<(MXPRFONL-1) S NUMMISS=MXPRFONL-NUMHRFS-1
Q
;
;return 1 if the patient has a least one inactive flag that qualifies for showing in OTH/PP/Inact PRG button
;return 0 if not
;Input:
; PRFTMP - the node for PRFs used by $$PRFINFO^DGOTHBT2
; DGDFN - patient's DFN
QUALINACT(PRFTMP,DGDFN) ;
I +$G(^TMP($J,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE")) Q 1
I +$G(^TMP($J,PRFTMP,DGDFN,"I","MISSING PATIENT")) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHBT2 19421 printed Dec 13, 2024@02:46:43 Page 2
DGOTHBT2 ;SLC/SS,JC - OTH AND PP APIs ; 09/22/2020
+1 ;;5.3;Registration;**1029,1035,1047,1100,1126**;Aug 13, 1993;Build 3
+2 ;ICRs: $$INSUR^IBBAPI - DBIA4419
+3 ;* Returns Category I PRF information
+4 ;Input:
+5 ; DGDFN - IEN in the file (#2)
+6 ;Output:
+7 ; Piece #1:
+8 ; "Y" patient has at least one Category I PRF flag
+9 ; "N" patient does not have any Category I PRF flags
+10 ; Piece #2:
+11 ; "A" patient has at least one active PRF
+12 ; "" patient does not have any active PRF flags
+13 ; Piece #3:
+14 ; "I" patient has at least one inactive PRF
+15 ; "" patient does not have any inactive PRF flags
+16 ; DGRET - subscript for ^TMP($J,DGRET,DFN)array to return data from $$GETALL^DGPFAA
+17 ;Example of the returned value:
+18 ; Y^A - if only one active flag
+19 ; Y^^I - if only one inactive flag
+20 ; Y^A^I - if have both active and inactive flag
+21 ; N - if there are no PRF flags
+22 ;Example of the array:
+23 ;PRFARR("A","BEHAVIORAL")=123
+24 ;PRFARR("A","HIGH RISK FOR SUICIDE")=121
+25 ;PRFARR("I","MISSING PATIENT")=122
+26 ;
PRFINFO(DGDFN,DGRETGL) ;
+1 NEW DGIENS,DGIEN,DGARR,DGRETVL,DGIEN2,DGRET2,DGFLSARR,DGRET,DGEIECHK
+2 KILL DGRET
+3 SET DGRETVL="N"
+4 KILL ^TMP($JOB,DGRETGL,DGDFN)
+5 ; get all assignment ien's for the patient for
+6 ; - both active and inactive flags, the 3rd parameter = ""
+7 ; - only Category I (national flag), the 4th parameter = 1
+8 ;Selected patient has no record flag assignments on file.
+9 IF '$$GETALL^DGPFAA(DGDFN,.DGRET2,"",1)
QUIT DGRETVL
+10 ;check what statuses we have at the moment for each flag and set the return value's pieces accordingly
+11 SET DGIEN=""
FOR
SET DGIEN=$ORDER(DGRET2(DGIEN))
if DGIEN=""
QUIT
Begin DoDot:1
+12 SET DGEIECHK=$$CHECKEIE(DGIEN)
+13 IF DGEIECHK
QUIT
+14 KILL DGARR
+15 SET DGIEN2=DGIEN_","
+16 DO GETS^DIQ(26.13,DGIEN2,".02;.03","IE","DGARR")
+17 IF $GET(DGARR(26.13,DGIEN2,.03,"E"))="ACTIVE"
SET DGRET("A",$GET(DGARR(26.13,DGIEN2,.02,"E")))=DGIEN
SET $PIECE(DGRETVL,U,2)="A"
SET $PIECE(DGRETVL,U,1)="Y"
+18 IF '$TEST
IF $GET(DGARR(26.13,DGIEN2,.03,"E"))="INACTIVE"
SET DGRET("I",$GET(DGARR(26.13,DGIEN2,.02,"E")))=DGIEN
SET $PIECE(DGRETVL,U,3)="I"
SET $PIECE(DGRETVL,U,1)="Y"
End DoDot:1
+19 MERGE ^TMP($JOB,DGRETGL,DGDFN)=DGRET
+20 ;add all other related information about the flags, its history and patient data to the ^TMP
+21 if $PIECE(DGRETVL,U,3)="I"
DO PRFAPI(DGDFN,DGRETGL,"I")
+22 if $PIECE(DGRETVL,U,2)="A"
DO PRFAPI(DGDFN,DGRETGL,"A")
+23 QUIT DGRETVL
+24 ;
CHECKEIE(DGIEN) ;
+1 NEW DGBX,DGCDGPF,DGSFLAG,DGEIE,DGBXP,DGBXPFLAG,DGBXPF
+2 SET DGBX=0
SET DGEIE=0
+3 FOR
SET DGBX=$ORDER(^DGPF(26.14,"B",DGIEN,DGBX))
if DGBX=""
QUIT
Begin DoDot:1
+4 SET DGCDGPF=$GET(^DGPF(26.14,DGBX,0))
+5 SET DGSFLAG=$PIECE(DGCDGPF,U,3)
+6 if DGSFLAG'=5
QUIT
+7 SET DGEIE=1
SET DGBXP=$ORDER(^DGPF(26.14,"B",DGIEN,DGBX),-1)
+8 SET DGBXPF=$GET(^DGPF(26.14,DGBXP,0))
+9 SET DGBXPFLAG=$PIECE(DGBXPF,U,3)
+10 IF DGBXPFLAG'=1
SET DGEIE=0
End DoDot:1
+11 QUIT DGEIE
+12 ;
PRFAPI(DGDFN,DGRETGL,DGACT) ;
+1 NEW DGARFLAG,DGIEN,DGPRFFL,DGARRHS
+2 SET DGPRFFL=""
FOR
SET DGPRFFL=$ORDER(^TMP($JOB,DGRETGL,DGDFN,DGACT,DGPRFFL))
if DGPRFFL=""
QUIT
SET DGIEN=+$GET(^TMP($JOB,DGRETGL,DGDFN,DGACT,DGPRFFL))
IF DGIEN>0
KILL DGARFLAG
IF $$GETASGN^DGPFAA(DGIEN,.DGARFLAG)
Begin DoDot:1
+3 MERGE ^TMP($JOB,DGRETGL,DGDFN,DGACT,DGPRFFL,"D")=DGARFLAG
+4 KILL DGARRHS
DO GETHIST(DGIEN,.DGARRHS)
+5 MERGE ^TMP($JOB,DGRETGL,DGDFN,DGACT,DGPRFFL,"H")=DGARRHS
End DoDot:1
+6 QUIT
+7 ;
+8 ;Get history
+9 ;Input:
+10 ; DGIEN13 - IEN of #26.14
+11 ; DGACT - "A" for active, "I" for inactive
+12 ; DGPRFFL - full name of the flag (MISSING PATIENT, BEHAVIORAL or HIGH RISK FOR SUICIDE)
+13 ; DGARRFL - array to return (merge with)
GETHIST(DGIEN13,DGARRFL) ;
+1 NEW DGIEN14,DGDTTM,DGIENS,DGARRH
+2 IF '$$GETALLDT^DGPFAAH(DGIEN13,.DGIENS)
QUIT
+3 SET DGDTTM=""
FOR
SET DGDTTM=$ORDER(DGIENS(DGDTTM))
if +DGDTTM=0
QUIT
SET DGIEN14=$GET(DGIENS(DGDTTM))
IF DGIEN14
Begin DoDot:1
+4 KILL DGARRH
+5 IF $$GETHIST^DGPFAAH(DGIEN14,.DGARRH,1)
MERGE DGARRFL(DGDTTM)=DGARRH
End DoDot:1
+6 QUIT
+7 ;show inactive PRF only
+8 ; Inactive Flag (non-OTH, non-PP, but has inactive HRFS and/or MISSING PATIENT PRF(s)) -> "Inactive Flag"
+9 ; Note: "BEHAVIORAL" should not be displayed according requirements
+10 ;Input:
+11 ; PRFARR - returned by S PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,.PRFARR)
+12 ; RET - local array to return information to send back to CPRS
+13 ;Output:
+14 ; RET - local array to return information to send back to CPRS
+15 ;Example:DGPFAPIH
INPRFONL(DGDFN,PRFTMP,RET) ;
+1 NEW DGFLIEN1,DGFLIEN2,DGCNT,DGRECN,DGMXHRFS
+2 NEW NUMHRFS,NUMMISS
+3 SET (NUMHRFS,NUMMISS)=0
+4 SET RET(0)=0
+5 SET DGFLIEN1=+$GET(^TMP($JOB,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
+6 SET DGFLIEN2=+$GET(^TMP($JOB,PRFTMP,DGDFN,"I","MISSING PATIENT"))
+7 IF 'DGFLIEN1
IF 'DGFLIEN2
QUIT
+8 IF DGFLIEN1
SET NUMHRFS=$$HISTLEN(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE")
+9 IF DGFLIEN2
SET NUMMISS=$$HISTLEN(PRFTMP,DGDFN,"I","MISSING PATIENT")
+10 ;
DO HISTRECS("N",.NUMHRFS,.NUMMISS)
+11 DO ADDLINE(.RET,"Inactive Flag^Patient has Inactive Flag(s), click to view")
+12 DO ADDLINE(.RET," ")
+13 IF DGFLIEN1
DO SETHRFS(.RET,PRFTMP,DGDFN,NUMHRFS)
+14 IF DGFLIEN1
DO ADDLINE(.RET," ")
+15 IF DGFLIEN2
DO SETMISP(.RET,PRFTMP,DGDFN,NUMMISS)
+16 QUIT
+17 ;set header and history for HRfS
+18 ;RET to set array for CPRS
+19 ;PRFTMP - subscript in the TMP global
+20 ;DGHISNUM - number of history records to show
+21 ; - if patient has both HRfS and MISSING flags
+22 ; then HRfS will be shown first but we need to save a space for MISSING as well
+23 ; therefore we have to show fewer history entries for HRfS i.e. just 1 entry
+24 ; - if patient has only one HRfS flag then we show 2 entries
SETHRFS(RET,PRFTMP,DGDFN,DGHISNUM) ;
+1 DO ADDLINE(.RET,"Flag name: HIGH RISK FOR SUICIDE Status: INACTIVE")
+2 DO ADDLINE(.RET," Initial Assigned Date: "_$$FLGASSDT(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
+3 DO ADDLINE(.RET," Originating Site: "_$$FORGSITE(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
+4 DO ADDLINE(.RET," Owner Site: "_$$FLOWNSITE(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
+5 DO ADDHIST(.RET,PRFTMP,DGDFN,"HIGH RISK FOR SUICIDE","I",DGHISNUM)
+6 QUIT
+7 ;return FLG ASSIG DATE
+8 ;parameters: DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM
FLGASSDT(DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM) ;
+1 NEW DG2613,DGDTTM
+2 SET DGDTTM=0
+3 SET DG2613=$GET(^TMP($JOB,DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM))
+4 IF DG2613
SET DGDTTM=+$$GETADT^DGPFAAH(DG2613)
+5 IF DGDTTM>0
QUIT $$DATETM(DGDTTM)
+6 QUIT "UNKNOWN"
+7 ;
FORGSITE(DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM) ;return FLG SITE
+1 QUIT $PIECE($GET(^TMP($JOB,DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM,"D","ORIGSITE")),U,2)
+2 ;
FLOWNSITE(DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM) ;return flag owner site
+1 QUIT $PIECE($GET(^TMP($JOB,DGPRFTMP,DGDFN,DGSTATUS,DGFLGNAM,"D","OWNER")),U,2)
+2 ;
+3 ;return ARR array with DGNUM of history entries
+4 ;RET to set array for CPRS
+5 ;PRFTMP - subscript in the TMP global
+6 ;DGHISNUM - number of history records to show
ADDHIST(RET,PRFTMP,DGDFN,DGFLAG,DGSTAT,DGNUM) ;
+1 NEW DGCNT,DGDTTM,DGACTION,DGSITE,DGMOREHI,DGZ,DGPRSITE,DGDTTIME
+2 SET DGPRSITE=""
+3 SET DGDTTM=99999999
SET DGCNT=0
SET DGMOREHI=0
+4 FOR
SET DGDTTM=$ORDER(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM),-1)
if +DGDTTM=0!(DGCNT'<DGNUM)
QUIT
Begin DoDot:1
+5 SET DGACTION=$PIECE($GET(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ACTION")),U,2)
+6 ;if not one of them then don't use (don't display)
+7 SET DGZ="^"_DGACTION_"^"
+8 IF "^INACTIVATE^REACTIVATE^CONTINUE^"'[DGZ
QUIT
+9 SET DGSITE=$GET(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ORIGFAC"))
+10 SET DGDTTIME=$GET(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ASSIGNDT"))
+11 IF DGPRSITE'=$PIECE(DGSITE,U,2)
DO ADDLINE(.RET," "_$PIECE(DGSITE,U,2)_" changes:")
+12 DO ADDLINE(.RET," DATE/TIME: "_$PIECE(DGDTTIME,U,2)_" ACTION: "_DGACTION)
+13 SET DGPRSITE=$PIECE(DGSITE,U,2)
+14 SET DGCNT=DGCNT+1
End DoDot:1
+15 ;are there are more items to show?
+16 IF $$IFMORE(PRFTMP,DGDFN,DGSTAT,DGFLAG,DGDTTM)>0
DO ADDLINE(.RET," *****additional info is in vista*****")
+17 QUIT
+18 ;
+19 ;check is we have more entries with INACTIVATE,REACTIVATE and CONTINUE to display
IFMORE(PRFTMP,DGDFN,DGSTAT,DGFLAG,DGDTTM) ;
+1 NEW DGZ,DGFND
+2 SET DGDTTM=DGDTTM+.00000000001
+3 SET DGFND=0
+4 FOR
SET DGDTTM=$ORDER(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM),-1)
if +DGDTTM=0!(DGFND>0)
QUIT
Begin DoDot:1
+5 SET DGACTION=$PIECE($GET(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ACTION")),U,2)
+6 ;if not one of them then don't use (don't display)
+7 SET DGZ="^"_DGACTION_"^"
+8 IF "^INACTIVATE^REACTIVATE^CONTINUE^"[DGZ
SET DGFND=1
End DoDot:1
+9 QUIT DGFND
+10 ;
+11 ;/**
+12 ;set header and history for MISSING PATIENT
+13 ;RET to set array for CPRS
+14 ;PRFTMP - subscript in the TMP global
+15 ;*/
SETMISP(RET,PRFTMP,DGDFN,DGHISNUM) ;
+1 DO ADDLINE(.RET,"Flag name: MISSING PATIENT Status: INACTIVE")
+2 DO ADDLINE(.RET," Initial Assigned Date: "_$$FLGASSDT(PRFTMP,DGDFN,"I","MISSING PATIENT"))
+3 DO ADDLINE(.RET," Originating Site: "_$$FORGSITE(PRFTMP,DGDFN,"I","MISSING PATIENT"))
+4 DO ADDLINE(.RET," Owner Site: "_$$FLOWNSITE(PRFTMP,DGDFN,"I","MISSING PATIENT"))
+5 DO ADDHIST(.RET,PRFTMP,DGDFN,"MISSING PATIENT","I",DGHISNUM)
+6 QUIT
+7 ;show OTH + PRF
+8 ;Input:
+9 ; DGEXP - OTH data from $$GETEXPR^DGOTHD(DGDFN)
+10 ; PRFTMP - subscript to ^TMP($J,PRFTMP) with PRF data
+11 ; RET - to return an array with data
+12 ;Output:
+13 ; RET(0)=0 - nothing to display
+14 ;or
+15 ; RET(0)>0, RET - with data to display on the button
OTHINPRF(DGDFN,DGEXP,PRFTMP,RET) ;
+1 NEW DGOTHTYP
+2 SET RET(0)=0
+3 ;determine the OTH type
+4 SET DGOTHTYP=$$ISOTH^DGOTHD(DGEXP)
+5 ;if OTH-EXT
+6 ;Button label:
+7 ; OTH and Inactive Flag (OTH EXT and has inactive HRFS and/or MISSING PATIENT PRF(s)) "OTH/Inactive Flag"
+8 ; OTH-EXT and Inactive Flag:
+9 ;Button Hover text 1st line: 'Other than Honorable, click for details'
+10 ;Button Hover text 2nd line: 'Patient has Inactive Flag(s), click to view'
+11 IF DGOTHTYP=1
Begin DoDot:1
+12 SET RET(0)=11
+13 SET RET(1)="OTH-EXT^Other than Honorable, click for details"
+14 SET RET(2)="Inactive Flag^Patient has Inactive Flag(s), click to view"
+15 SET RET(3)="Other than Honorable - Extended"
+16 SET RET(4)=" "
+17 SET RET(5)="Eligible for Mental Health care only unless Veteran has positive MST screen."
+18 SET RET(6)=" "
+19 SET RET(7)="If MST Screen is positive, Veteran is eligible for MST related mental health and medical care."
+20 SET RET(8)="Please review MST checkbox or complete MST screening."
+21 SET RET(9)=" "
+22 SET RET(10)="Not time limited - pending VBA adjudication."
+23 SET RET(11)="Adjudication will determine eligibility for continuing care."
+24 DO PRWTHOTH(DGDFN,"DGPRINFO",.RET)
+25 QUIT
End DoDot:1
QUIT
+26 ;if OTH-90
+27 ;Button label:
+28 ; OTH-90 and Inactive Flag (OTH-90 and has inactive HRFS and/or MISSING PATIENT PRF(s)) "OTH/Inactive Flag"
+29 ; OTH and Inactive Flag
+30 ;1st line on button hover text: 'Other Than Honorable, click for details'
+31 ;2nd line on button hover text: 'Patient has Inactive Flag(s), click to view'
+32 IF DGOTHTYP=2
Begin DoDot:1
+33 DO OTH90^DGOTHBTN(DGDFN,.RET)
+34 ;overwrite label and hover text
+35 SET RET(1)="OTH-90^Other than Honorable, click for details"
+36 SET RET(2)="Inactive Flag^Patient has Inactive Flag(s), click to view"
+37 DO PRWTHOTH(DGDFN,"DGPRINFO",.RET)
End DoDot:1
QUIT
+38 QUIT
+39 ;show inactive PRF with OTH
+40 ; Note: "BEHAVIORAL" should not be displayed according requirements
+41 ;Input:
+42 ; PRFARR - returned by S PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,.PRFARR)
+43 ; RET - local array to return information to send back to CPRS
+44 ;Output:
+45 ; RET - local array to return information to send back to CPRS
+46 ;Example:DGPFAPIH
PRWTHOTH(DGDFN,PRFTMP,RET) ;
+1 NEW DGFLIEN1,DGFLIEN2,DGCNT,DGRECN,DGMXHRFS
+2 NEW NUMHRFS,NUMMISS
+3 SET (NUMHRFS,NUMMISS)=0
+4 SET DGFLIEN1=+$GET(^TMP($JOB,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
+5 SET DGFLIEN2=+$GET(^TMP($JOB,PRFTMP,DGDFN,"I","MISSING PATIENT"))
+6 IF DGFLIEN1
SET NUMHRFS=$$HISTLEN(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE")
+7 IF DGFLIEN2
SET NUMMISS=$$HISTLEN(PRFTMP,DGDFN,"I","MISSING PATIENT")
+8 ;
DO HISTRECS("O",.NUMHRFS,.NUMMISS)
+9 DO ADDLINE(.RET," ")
+10 IF DGFLIEN1
DO SETHRFS(.RET,PRFTMP,DGDFN,NUMHRFS)
+11 IF DGFLIEN1
DO ADDLINE(.RET," ")
+12 IF DGFLIEN2
DO SETMISP(.RET,PRFTMP,DGDFN,NUMMISS)
+13 QUIT
+14 ;
+15 ;/**
+16 ;show inactive PRF with PP
+17 ; Note: "BEHAVIORAL" should not be displayed according requirements
+18 ;Input:
+19 ; PRFARR - returned by S PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,.PRFARR)
+20 ; RET - local array to return information to send back to CPRS
+21 ;Output:
+22 ; RET - local array to return information to send back to CPRS
+23 ;
+24 ;Example:DGPFAPIH
+25 ;
+26 ;*/
PRWITHPP(DGDFN,PRFTMP,RET) ;
+1 NEW DGFLIEN1,DGFLIEN2,DGCNT,DGRECN,DGMXHRFS
+2 NEW NUMHRFS,NUMMISS
+3 SET (NUMHRFS,NUMMISS)=0
+4 SET DGFLIEN1=+$GET(^TMP($JOB,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
+5 SET DGFLIEN2=+$GET(^TMP($JOB,PRFTMP,DGDFN,"I","MISSING PATIENT"))
+6 IF DGFLIEN1
SET NUMHRFS=$$HISTLEN(PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE")
+7 IF DGFLIEN2
SET NUMMISS=$$HISTLEN(PRFTMP,DGDFN,"I","MISSING PATIENT")
+8 ;
DO HISTRECS("P",.NUMHRFS,.NUMMISS)
+9 ;DG*5.3*1100 ensures the RET array is setup correctly
DO ADDLINE(.RET,"Inactive Flag^Patient has Inactive Flag(s), click to view")
+10 DO ADDLINE(.RET," ")
+11 IF DGFLIEN1
DO SETHRFS(.RET,PRFTMP,DGDFN,NUMHRFS)
+12 IF DGFLIEN1
DO ADDLINE(.RET," ")
+13 IF DGFLIEN2
DO SETMISP(.RET,PRFTMP,DGDFN,NUMMISS)
+14 QUIT
+15 ;
+16 ;/** Check if any mailman message was already sent today and send the MailMan message for this patient
+17 ;Input parameters:
+18 ;*/
SENDMAIL(DGDFN) ;
+1 NEW DGSENTON
+2 ;get the date when the message was sent last time (if we have a record for this)
+3 SET DGSENTON=$$MMSENTON(DGDFN)
+4 ;if there is no any ^XTM record about last mailman message then MailMan message can be sent now and create the ^XTMP global entry
+5 IF DGSENTON=0
DO COMPSEND(DGDFN)
QUIT
+6 ;if the date MM was sent last time is the same as today then do not sent message
+7 IF DGSENTON=DT
QUIT
+8 ;if the date MM was sent last time on a different day then send the message and update the ^XTMP global entry
+9 DO COMPSEND(DGDFN)
+10 QUIT
+11 ;
COMPSEND(DGDFN) ;Compose the message that notifies the Registration users added to the DGEN ELIGIBILITY ALERT group
+1 NEW DGMSG
+2 ;send email
+3 DO COMPMSG(DGDFN,.DGMSG)
+4 DO SENDMSG(.DGMSG,"Presumptive Psychosis information needed")
+5 DO SETXTMP(DGDFN)
+6 QUIT
+7 ;Compose the message that notifies the Registration users added to the DGEN ELIGIBILITY ALERT group
+8 ;that PP workaround settings are not completed for the patient
+9 ;Input parameters:
+10 ;the mockup of the message sent to the DGEN ELIGIBILITY ALERT mail group:
+11 ;The following patient has PRESUMED PSYCHOSIS indicated,but all fields have not
+12 ;been completed to support this. All fields must be completed in order for this
+13 ;patient to be eligible for treatment under the Presumed Psychosis Program.
+14 ;
+15 ;Required Fields: Screen 7, Field 3
+16 ; Screen 11, Field 4
+17 ;
+18 ;PATIENT NAME: ZZTEST,PRESUMED PSYCHOSIS
+19 ; Last 4 SSN: 1234
COMPMSG(DGDFN,DGMSG) ;
+1 NEW DGNAME,DGSSN,DGPAT,DGDFN1
+2 SET DGDFN1=DGDFN_","
+3 DO GETS^DIQ(2,DGDFN1,".01;.09","EI","DGPAT")
IF '$DATA(DGPAT)
QUIT
+4 SET DGSSN=DGPAT(2,DGDFN1,.09,"E")
+5 SET DGNAME=DGPAT(2,DGDFN1,.01,"E")
+6 SET DGMSG(1)="The following patient has PRESUMED PSYCHOSIS indicated,but all fields have not"
+7 SET DGMSG(2)="been completed to support this. All fields must be completed in order for this"
+8 SET DGMSG(3)="patient to be eligible for treatment under the Presumed Psychosis Program."
+9 SET DGMSG(4)=" "
+10 SET DGMSG(5)="Required Fields: Screen 7, Field 3"
+11 SET DGMSG(6)=" Screen 11, Field 4"
+12 SET DGMSG(7)="PATIENT NAME: "_DGNAME
+13 SET DGMSG(8)=" Last 4 SSN: "_$EXTRACT(DGSSN,$LENGTH(DGSSN)-3,$LENGTH(DGSSN))
+14 QUIT
+15 ;
+16 ;/** Send MailMan message to DGEN ELIGIBILITY ALERT group
+17 ;Input parameters:
+18 ; DGMSG - array with the text
+19 ; DGSUBJ - mailman subject
+20 ;*/
SENDMSG(DGMSG,DGSUBJ) ;
+1 NEW XMDUZ,XMTEXT,XMY,XMSUB
+2 SET XMSUB=DGSUBJ
+3 SET XMDUZ="POSTMASTER"
SET XMTEXT="DGMSG("
SET XMY("G.DGEN ELIGIBILITY ALERT@"_^XMB("NETNAME"))=""
+4 ; Returns: XMZ(if no error),XMMG(if error)
DO ^XMD
+5 QUIT
+6 ;
+7 ;/**
+8 ;mailman was sent last time on the date?
+9 ;Input parameters:
+10 ;output parameters:
+11 ; returns
+12 ; 0 - there is no any ^XTM record about last mailman message (which means message can be sent now)
+13 ; 1 - the date when the message was sent last time
+14 ;*/
MMSENTON(DGDFN) ;
+1 NEW DGVAL
+2 SET DGVAL=$GET(^XTMP("DGPPMSGFOR"_DGDFN,0))
+3 IF +DGVAL=0
QUIT 0
+4 QUIT $PIECE(DGVAL,U,2)
+5 ;
+6 ;/** Set ^XTMP entry so we can check for it and prevent sending the mailman message more than once a day
+7 ;Input parameters:
+8 ;*/
SETXTMP(DGDFN) ;
+1 NEW DGPURGE,DGNODE
+2 SET DGPURGE=$$FMADD^XLFDT(DT,1)
+3 SET DGNODE="DGPPMSGFOR"_DGDFN
+4 SET ^XTMP(DGNODE,0)=DGPURGE_U_DT_U_"DG PP MSG WAS SENT"
+5 QUIT
+6 ;
+7 ;/**add lines to the CPRS array RET
+8 ; RET - the local array by reference
+9 ; DGTEXT - text to add
+10 ;*/
ADDLINE(RET,DGTEXT) ;
+1 SET RET(0)=$GET(RET(0))+1
+2 SET RET(RET(0))=DGTEXT
+3 QUIT
+4 ;
+5 ;FM date to MON DD, YYYY@HH:MM
DATETM(Y) ;
+1 DO DD^%DT
WRITE Y
+2 QUIT Y
+3 ;
+4 ;/*
+5 ;returns number of records in the PRF history
+6 ;Note: will count only INACTIVATE,REACTIVATE,CONTINUE
+7 ;PRFTMP - subscript in the TMP global
+8 ;DGSTAT - status ("A" or "I")
+9 ;DGFLAG - full flag name
+10 ;*/
HISTLEN(PRFTMP,DGDFN,DGSTAT,DGFLAG) ;
+1 NEW DGCNT,DGDTTM,DGZ,DGACTION
+2 SET DGCNT=0
SET DGDTTM=""
+3 FOR
SET DGDTTM=$ORDER(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM))
if +DGDTTM=0
QUIT
Begin DoDot:1
+4 SET DGACTION=$PIECE($GET(^TMP($JOB,PRFTMP,DGDFN,DGSTAT,DGFLAG,"H",DGDTTM,"ACTION")),U,2)
+5 ;if not one of the three below then don't count and don't use (don't display)
+6 SET DGZ="^"_DGACTION_"^"
+7 IF "^INACTIVATE^REACTIVATE^CONTINUE^"'[DGZ
QUIT
+8 SET DGCNT=DGCNT+1
End DoDot:1
+9 QUIT DGCNT
+10 ;
+11 ;Calculate max number of history records to display for HRfS and MISSING if
+12 ; we have PP
+13 ; OTH
+14 ; and when we don't have any of PP or OTH
+15 ;
+16 ;this number depends on the number of history records for each HRFS and MISSING we found for the patient
+17 ;
+18 ;Note: HRFS always displayed first, then MISSING
+19 ; MISSING should display at least one history record
+20 ;
+21 ;Parameters:
+22 ; DGPPOTH - "P" if patient has PP
+23 ; "O" if patient has OTH
+24 ; "N" if patient does not have OTH and PP
+25 ; NUMHRFS - number of history records for HRfS , passed by reference so it will be adjusted accordingly
+26 ; NUMMISS - number of history records for MISSING , passed by reference so it will be adjusted accordingly
+27 ;
HISTRECS(DGPPOTH,NUMHRFS,NUMMISS) ;
+1 NEW MXPRFONL
+2 ;MAX number of records in total if not OTH and no PP, just PRF
SET MXPRFONL=6
+3 ;if not OTH and no PP
+4 ;to allow the space for PP info
IF DGPPOTH="P"
SET MXPRFONL=5
+5 ;to allow the space for OTH info
IF DGPPOTH="O"
SET MXPRFONL=5
+6 ;if we have only MISSING then set to MAX and it will display all entries less than MAX or upto MAX in ADDHIST function
+7 IF NUMHRFS=0
SET NUMMISS=MXPRFONL
QUIT
+8 ;if we have only HRfS then set to MAX and it will display all entries less than MAX or upto MAX in ADDHIST function
+9 IF NUMMISS=0
SET NUMHRFS=MXPRFONL
QUIT
+10 ;now if we have both HRfS and MISSING ...
+11 ;
+12 ;if total number of records is less than MAX ( "less then < MXPRFONL" because generic info for the MISSING will take some space too)
+13 ;and leave all as is - ADDHIST function will display all entries for each
+14 ;example: NUMHRFS=4,NUMMISS=1 or NUMHRFS=1,NUMMISS=4 or NUMHRFS=3,NUMMISS=2
+15 IF (NUMHRFS+NUMMISS)<MXPRFONL
QUIT
+16 ;if total number of HRFS history entries no less than MXPRFONL-1 (because generic info for the MISSING will take some space too)
+17 ;example: NUMHRFS=5,NUMMISS=1 or NUMHRFS=7,NUMMISS=8
+18 IF NUMHRFS'<(MXPRFONL-1)
SET NUMHRFS=MXPRFONL-2
SET NUMMISS=1
+19 ;if total number of HRFS history entries less than MXPRFONL-1 (because generic info for the MISSING will take some space too)
+20 ;example: NUMHRFS=4,NUMMISS=1 or NUMHRFS=3,NUMMISS=8
+21 IF NUMHRFS<(MXPRFONL-1)
SET NUMMISS=MXPRFONL-NUMHRFS-1
+22 QUIT
+23 ;
+24 ;return 1 if the patient has a least one inactive flag that qualifies for showing in OTH/PP/Inact PRG button
+25 ;return 0 if not
+26 ;Input:
+27 ; PRFTMP - the node for PRFs used by $$PRFINFO^DGOTHBT2
+28 ; DGDFN - patient's DFN
QUALINACT(PRFTMP,DGDFN) ;
+1 IF +$GET(^TMP($JOB,PRFTMP,DGDFN,"I","HIGH RISK FOR SUICIDE"))
QUIT 1
+2 IF +$GET(^TMP($JOB,PRFTMP,DGDFN,"I","MISSING PATIENT"))
QUIT 1
+3 QUIT 0
