- 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 Jan 18, 2025@03:47:24 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