Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGOTHBT2

DGOTHBT2.m

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