- DGOTHBTN ;SLC/SS,RM,JC - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ; 03/27/2019
- ;;5.3;Registration;**952,977,1029,1035,1047**;Aug 13, 1993;Build 13
- ;
- ;
- ;ICR# TYPE DESCRIPTION
- ;----- ---- ---------------------
- ; 2056 Sup ^DIQ : GETS
- ;10103 Sup ^XLFDT: $$FMADD,$$FMDIFF
- ; 2992 Sup ^XTV(8989.51) access
- ;
- ;Functionality:
- ;This function is called from the "OROTHCL GET" RPC to compose
- ; OTH (Other Than Honorable) status,
- ; PP (Presumptive Psychosis) status,
- ; PRF (Patient Record Flag) and its history
- ; as a text to display in OTH/PP/inactive PRF history button and associated pop-up message in CPRS.
- ;Will be called by OROTHCL code, that is used by ORTHCL GET RPC
- ;See also the DG ICR# 6873 that provides CPRS access to this API.
- ;
- ;Input parameters:
- ; RET - reference type parameter to return data
- ; DGDFN - patient's IEN in the file (#2)
- ; DGDATE - the date to calculate status and compose the text to return to CPRS
- ; default = DT (today)
- ;
- ;ATTENTION: Here below is what the ORTHCL GET RPC is supposed to return to GUI code
- ; (actual return values of this API below not necessarily should be the same
- ; but need to provide all information to support OR M-code that will pass it to the OR RPC)
- ;
- ;Return array:
- ;If RET(0)<0 : error code less than zero^error message - it is an error, and do not display anything
- ;
- ;If RET(0)=0 : then do not display anything in CPRS
- ;
- ;If RET(0)>0 : see the description below:
- ;
- ;RET(0) = number of lines to return
- ;RET(1) = text for the 1st line on the button ^Text to display when hover over the 1st line on the button
- ;RET(2) = text for the 2nd line on the button^Text to display when hover over the 2nd line on the button
- ;RET(3) = text for the 1st line of the button-click popup message ^ Text for the 1st line of the warning popup message (see the example for the OTH-90 below)
- ;RET(>3)= text lines for the rest of the text in the popup message when the user clicks on the button or for the warning popup message
- ;NOTE: empty or null values in array elements greater than 3 will not be displayed on the CPRS side.
- ; Enter at least a blank space in the piece to include a blank line in the displayed text.
- ;
- ;Example for OTH-EXT:
- ;RET(0)=6
- ;RET(1)="OTH-EXT^Other than Honorable, click for details"
- ;RET(2)=" "
- ;RET(3)="Other than Honorable - Extended"
- ;RET(4)="Eligible for Mental Health care only"
- ;RET(5)="Not time limited - pending VBA adjudication"
- ;RET(6)="Adjudication will determine eligibility for continuing care"
- ;
- ;Example for OTH-90 with zero days remaining:
- ;RET(0)=10
- ;RET(1)="OTH^Other than Honorable, click for details"
- ;RET(2)="0D,P1^Zero days remaining in the most recent period"
- ;RET(3)="Other Than Honorable Status"
- ;RET(4)=" "
- ;RET(5)="Zero days remaining in the most recent period^WARNING: EMERGENT MH OTH"
- ;RET(6)="^Zero days remaining in the most recent period."
- ;RET(7)="^Authorization from VISN Chief Medical Officer is required for an additional 90-Day period."
- ;RET(8)=" "
- ;RET(9)="Call Registration team for details."
- ;RET(10)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- ;
- ;Example for OTH-90 with less than 7 days remaining:
- ;RET(0)=10
- ;RET(1)="OTH^Other than Honorable, click for details"
- ;RET(2)="5D,P1^5 day(s) remaining in the current period"
- ;RET(3)="Other Than Honorable Status"
- ;RET(4)=" "
- ;RET(5)="5 day(s) remaining in the current period^WARNING: EMERGENT MH OTH"
- ;RET(6)="^Less than 7 day(s) remaining in the current period."
- ;RET(7)="^Authorization from VISN Chief Medical Officer is required for an additional 90-Day period."
- ;RET(8)=" "
- ;RET(9)="Call Registration team for details."
- ;RET(10)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- ;
- ;Example for OTH-90 with more than 7 days remaining:
- ;RET(0)=8
- ;RET(1)="OTH^Other than Honorable, click for details"
- ;RET(2)="80D,P1^80 day(s) remaining in the current period"
- ;RET(3)="Other Than Honorable Status"
- ;RET(4)=" "
- ;RET(5)="80 day(s) remaining in the current period"
- ;RET(6)=" "
- ;RET(7)="Call Registration Team for Details."
- ;RET(7)=RET(7)_Additional Line 1 if defined in ^XTV(8989.51,IEN,20,1,0)
- ;RET(8)=Additional Line 2 if defined in ^XTV(8989.51,IEN,20,2,0) or it will be a blank line.
- ;RET(9)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- ;
- ;Example for PP workaround settings only:
- ;RET(0)=7
- ;RET(1)="PP^Presumptive Psychosis Authority, click for details"
- ;RET(2)="^"
- ;RET(3)="Eligible for mental health care only under Presumptive Psychosis"
- ;RET(4)="Authority."
- ;RET(5)="PP Category: No value was selected as PP Indicator is not completed."
- ;RET(6)="Patients who experienced MST are eligible for MST related mental"
- ;RET(7)="health and medical care."
- ;
- ;Example for PP workaround settings and PP category:
- ;RET(0)=7
- ;RET(1)="PP^Presumptive Psychosis Authority, click for details"
- ;RET(2)="Fsm^Former Service Member with prior OTH discharge; should now be post-adjudication."
- ;RET(3)="Eligible for mental health care only under Presumptive Psychosis"
- ;RET(4)="Authority: Former Service Member with prior OTH discharge;"
- ;RET(5)="should now be post-adjudication."
- ;RET(6)="Patients who experienced MST may be eligible for MST-related care;"
- ;RET(7)="check with Eligibility for specifics."
- ;
- ;Example for PP category without PP workaround settings (the mailman will be also sent to the DGEN ELIGIBILITY ALERT group in DGOTHBT2):
- ;RET(0)=6
- ;RET(1)="PP^Presumptive Psychosis Authority, click for details"
- ;RET(2)="Dec^VETERAN DECLINES ENROLLMENT"
- ;RET(3)="Eligible for mental health care only under Presumptive Psychosis"
- ;RET(4)="Authority: VETERAN DECLINES ENROLLMENT."
- ;RET(5)="Patients who experienced MST are eligible for MST related mental"
- ;RET(6)="health and medical care." ^
- ;
- ;Example for inactive PRFs:
- ;RET(0)=23
- ;RET(1)="Inactive Flag^Patient has Inactive Flag(s), click to view"
- ;RET(2)=" "
- ;RET(3)="Flag name: HIGH RISK FOR SUICIDE Status: INACTIVE"
- ;RET(4)=" Initial Assigned Date: OCT 12, 2020@16:27:10"
- ;RET(5)=" Originating Site: CAMP MASTER"
- ;RET(6)=" Owner Site: CAMP MASTER"
- ;RET(7)=" CAMP MASTER changes:"
- ;RET(8)=" DATE/TIME: NOV 25, 2020@10:45:44 ACTION: INACTIVATE"
- ;RET(9)=" BAY PINES VAMC changes:"
- ;RET(10)=" DATE/TIME: NOV 25, 2020@10:19:17 ACTION: REACTIVATE"
- ;RET(11)=" CAMP MASTER changes:"
- ;RET(12)=" DATE/TIME: NOV 24, 2020@09:26:06 ACTION: INACTIVATE"
- ;RET(13)=" NEW YORK HHS changes:"
- ;RET(14)=" DATE/TIME: NOV 24, 2020@09:25:30 ACTION: CONTINUE"
- ;RET(15)=" *****additional info is in vista*****"
- ;RET(16)=" "
- ;RET(17)="Flag name: MISSING PATIENT Status: INACTIVE"
- ;RET(18)=" Initial Assigned Date: OCT 12, 2020@16:27:54"
- ;RET(19)=" Originating Site: CAMP MASTER"
- ;RET(20)=" Owner Site: CAMP MASTER"
- ;RET(21)=" CAMP MASTER changes:"
- ;RET(22)=" DATE/TIME: DEC 01, 2020@12:06:47 ACTION: INACTIVATE"
- ;RET(23)=" *****additional info is in vista*****"
- ;
- ;
- OTHBTN(DGDFN,DGDATE,RET) ;
- ;
- N DGEXP,PPWRK,PPCAT,PRFINF
- K ^TMP($J,"DGPRINFO")
- S PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,"DGPRINFO")
- S RET(0)=0
- ;check OTH
- S DGEXP=$$GETEXPR^DGOTHD(DGDFN)
- ;if OTH (and possibly inactive PRF)
- I DGEXP'="" D OTH(DGEXP,DGDFN,.RET,PRFINF) K ^TMP($J,"DGPRINFO") Q
- ;check for PP workaround settings
- S PPWRK=$$PPWRKARN^DGPPAPI(DGDFN)
- ;check for PP category
- S PPCAT=$$PPINFO^DGPPAPI(DGDFN)
- ;if PP (and possibly inactive PRF)
- I PPWRK'="N"!(PPCAT'="") D PRESUMP(PPWRK,PPCAT,DGDFN,.RET,PRFINF) K ^TMP($J,"DGPRINFO") Q
- ;check if PRF
- ;if no inactive PRF then quit
- I $P(PRFINF,U,3)'="I" K ^TMP($J,"DGPRINFO") Q
- ;if at least one inactive PRF flag
- D INPRFONL^DGOTHBT2(DGDFN,"DGPRINFO",.RET)
- K ^TMP($J,"DGPRINFO")
- ;if nothing then don't display button - RET(0) is already set to 0
- Q
- ;
- ;/** Process OTH patient with or without inactive PRF
- ;check for OTH settings and prepare the text for the button and pop-up window
- ;Input:
- ; DGEXP - OTH data from $$GETEXPR^DGOTHD(DGDFN)
- ; DGDFN - IEN in the file (#2)
- ; 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
- ;*/
- OTH(DGEXP,DGDFN,RET,PRFINF) ;
- N PPRET
- S RET(0)=0
- ;if error then quit
- I DGEXP<0 S RET(0)=DGEXP Q
- ;if there are no any inactive PRF
- ;or there are no any inactive PRF that are qualified
- ;then show just OTH information
- I $P(PRFINF,U,3)'="I"!($$QUALINACT^DGOTHBT2("DGPRINFO",DGDFN)=0) D Q
- .I DGEXP'?1"OTH".E S RET(0)=0 Q
- .;determine the OTH type
- .I $$ISOTH^DGOTHD(DGEXP)>1 D Q
- ..;set RET for OTH-90 and return
- ..D OTH90(DGDFN,.RET)
- .;if OTH-EXT then set RET for OTH-EXT
- .S RET(0)=11
- .S RET(1)="OTH-EXT^Other than Honorable, click for details"
- .S RET(2)=" "
- .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."
- .Q
- ;if at least one inactive PRF
- D OTHINPRF^DGOTHBT2(DGDFN,DGEXP,"DGPRINFO",.RET)
- Q
- ;
- ;/**
- ;process PP patient with or without inactive PRF
- ;check for PP settings and prepare the text for the button and pop-up window
- ;Input:
- ; WRKARND - PP work around data from $$PPWRKARN^DGOTHBT2(DGDFN)
- ; PPIND - PP category data from $$PPINFO^DGOTHBT2(DGDFN)
- ; DGDFN - IEN in the file (#2)
- ; 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
- ;*/
- PRESUMP(WRKARND,PPIND,DGDFN,RET,PRFINF) ;
- N PPRET
- S RET(0)=0
- S PPRET=$P(PPIND,U,1)
- ;if there are no any inactive PRF
- ;then show just PP information
- D I $P(PRFINF,U,3)="I",$$QUALINACT^DGOTHBT2("DGPRINFO",DGDFN)=1 D PRWITHPP^DGOTHBT2(DGDFN,"DGPRINFO",.RET)
- .I PPRET="N" Q ;if indicator = NO then we NEVER show PP indicator
- .I PPIND="",WRKARND="N" Q ;if no indicator data AND no workaround settings then don't show PP indicator
- .I PPIND="",WRKARND="Y" D WORKARND(.RET) Q ;if no indicator data BUT workaround settings exist- then set RET to warn the user
- .I PPRET="Y",WRKARND="Y" D SHOWPP(PPIND,.RET) Q ;set RET for regular message when PP indicator data exist
- .I PPRET="Y",WRKARND="N" D SHOWPP(PPIND,.RET) D SENDMAIL^DGOTHBT2(DGDFN) Q ;set RET for regular message when PP indicator data exist
- ;if at least one inactive PRF
- Q
- ;
- ;
- OTH90(DGDFN,RET) ;calculate the CPRS EMERGENT OTH button
- K RET
- N DGN,DGIEN33,DGRET,DGCLCK,DGLS365D,DGLS365I,DG90A,DGCNTR,DG90,DGCRNT,LSTDAY
- N Z,DTSTR,DGSDT365,DGEDT365,DGSDT90,DGEDT90,DGNXT365,DGARR,DGERR,I,II,ZJMC
- I $$ISOTHD^DGOTHD(DGDFN)=0 S RET(0)="-1^Patient's primary eligibility code is no longer EXPANDED MH CARE NON-ENROLLEE" Q
- S DGIEN33=+$O(^DGOTH(33,"B",DGDFN,0))
- I DGIEN33=0 S RET(0)="-1^Unable to find an entry in OTH ELIGIBILITY PATIENT file #33 for this patient" Q
- D GETS^DIQ(33,DGIEN33_",",".01;.02;1*;2*","I","DGARR","DGERR")
- I $D(DGERR) S RET(0)="-1^FileMan Error #"_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1) Q
- I $G(DGARR(33,DGIEN33_",",.02,"I"))<1 S RET(0)="-1^Patient is no longer Other Than Honorable eligible" Q
- D CLOCK^DGOTHRP2(DGIEN33)
- I DGLS365D'>0 S RET(0)="-1^No 365 days clocks started" Q
- ;check if one of the 365 or 90-day period is missing
- I $$MSNGPRD(DGLS365D,.DGCLCK) Q
- D RESULT^DGOTHRP3(.DGARR,.DGCLCK,DGIEN33)
- I '$D(DGRET) S RET(0)="-1^Check patient's 90-Day period, one of them is missing" Q
- S DGCNTR=1,(LSTDAY,DGCRNT)=0
- S RET(DGCNTR)="OTH^Other than Honorable, click for details"
- S DGCNTR=DGCNTR+1
- F I=1:1:DGLS365D D
- . ;get date for the last 365 and 90-day period
- . I 'DGCRNT D LSTPRD
- . Q:DGCRNT>0
- . I DGRET(I)<1,$D(DGRET(I+1)) Q
- . S II="" F S II=$O(DGRET(I,II)) Q:II="" D
- . . N DG90
- . . S DG90=DGRET(I,II)
- . . I $P(DG90,U,3)<1,$D(DGRET(I,II+1)) Q
- . . I $P(DG90,U,2)=DT S LSTDAY=1
- . . I DGCNTR=2 S DGCRNT=1 D BTN,HDR,MST
- . . I $P(DG90,U,3)>=7,$P(DG90,U,3)<=90 D
- . . . I $P(DG90,U)>DT D AUTH1 Q
- . . . S DGCNTR=DGCNTR+1
- . . . S RET(DGCNTR)=$$POPUP
- . . . I '$D(DGRET(I,II+1)) D
- . . . . I 'DGNXT365 D AUTH1 Q
- . . . . D NXT365
- . . I $P(DG90,U,3)<7 D
- . . . ;display warning message
- . . . S DGCNTR=DGCNTR+1
- . . . S RET(DGCNTR)=$$POPUP
- . . . D WARN
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)=" "
- S DGCNTR=DGCNTR+1
- N LOCMSG1,LOCMSG2,DIE,DA,DR,ARRAY,DIC,X,LOCIEN,LOCDFLT
- S LOCDFLT="Call Registration Team for Details. "
- ; ICR 2992 access to ^XTV(8989.51
- S DIC="^XTV(8989.51,",DIC(0)="QEZ",X="OR OTH BTN LOCAL MSG"
- D ^DIC
- S LOCIEN=$P($G(Y),"^")
- D GETS^DIQ(8989.51,LOCIEN_",","**","","ARRAY")
- S LOCMSG1=$G(ARRAY(8989.51,LOCIEN_",","20",1))
- S LOCMSG2=$G(ARRAY(8989.51,LOCIEN_",","20",2))
- S RET(DGCNTR)=$G(LOCDFLT)_$G(LOCMSG1),DGCNTR=DGCNTR+1
- S RET(DGCNTR)=$G(LOCMSG2),DGCNTR=DGCNTR+1
- S RET(DGCNTR)=" ",DGCNTR=DGCNTR+1
- S RET(DGCNTR)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- S RET(0)=DGCNTR
- Q
- ;
- MSNGPRD(DGLS365D,DGCLCK) ;check if there are 90-Day period missing
- N I,II,MSNGPRD
- S MSNGPRD=0
- F I=1:1:DGLS365D D Q:MSNGPRD
- . I '$D(DGCLCK(I)) D Q
- . . S RET(0)="-1^The 365-Day period # "_I_" is missing."
- . . S MSNGPRD=1
- . F II=1:1:DGCLCK(I) D Q:MSNGPRD
- . . I DGCLCK(I,II)'=II D
- . . . S RET(0)="-1^The "_II_$S(II=1:"st",II=2:"nd",II=3:"rd",45[II:"th")_" 90-Day period for the 365 days period # "_I_" is missing."
- . . . S MSNGPRD=1
- Q MSNGPRD
- ;
- MST ;Text for MST information.
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)="Eligible for MH care only. Remember to perform MST screen."
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)=" "
- Q
- ;
- BTN ;Text to be displayed in the button and when user hover the button
- ;
- S RET(DGCNTR)=$S($G(LSTDAY):"LD",1:$P(DG90,U,3)_"D")_",P"_II_"^"_$$POPUP()
- Q
- ;
- HDR ;display popup message header
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)="Other Than Honorable Status"
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)=" "
- Q
- ;
- Q $S($G(LSTDAY):$$LSTDAY(),$P(DG90,U,3)=0:"Zero days remaining ",1:$P(DG90,U,3)_" day(s) remaining ")_"in the "_$$MSG()_" period"
- ;
- AUTH1 ;Display authorization verbiage in the popup message
- I $P(DG90,U,4)="" D Q
- . I $P(DG90,U)>DT S DGCNTR=DGCNTR+1 D AUTH3 Q
- . S DGCNTR=DGCNTR+1
- . S RET(DGCNTR)="Authorization required for further care."
- I DGSDT90<=DT D Q
- . S DGCNTR=DGCNTR+1
- . S RET(DGCNTR)=$$AUTH2()
- S DGCNTR=DGCNTR+1
- D AUTH3
- Q
- ;
- LSTDAY() ;
- Q "Last day patient is eligible for treatment "
- ;
- AUTH2() ;
- Q "Authorization from VISN Chief Medical Officer is required for an additional 90-Day period."
- ;
- AUTH3 ;
- S RET(DGCNTR)=$P(DG90,U,3)_" day(s) are authorized starting on "_$$FMTE^XLFDT($P(DG90,U))
- Q
- MSG() ;
- Q $S($G(LSTDAY):"current",(('DGNXT365)&(DGRET(I)>0)):"current",1:"most recent")
- ;
- WARN ;display warning message when user selects a patient less than 7 day(s) remaining.
- S RET(DGCNTR)=RET(DGCNTR)_"^WARNING: EMERGENT MH OTH"
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)=$S($G(LSTDAY):"^"_$$LSTDAY(),$P(DG90,U,3)=0:"^Zero days remaining ",1:"^Less than 7 day(s) remaining ")_"in the "_$$MSG()_" period."
- I 'DGNXT365 D Q
- . I DGSDT90<=DT D
- . . S DGCNTR=DGCNTR+1
- . . S RET(DGCNTR)="^"_$$AUTH2()
- . . I $P(DG90,U,3)<7 S RET(DGCNTR+1)=$P(RET(DGCNTR),U,2),DGCNTR=DGCNTR+1
- E D
- . I '$D(DGRET(I,II+1)) D
- . . S DGCNTR=DGCNTR+1
- . . S RET(DGCNTR)="^"_$$NXT2()
- . . D NXT365
- Q
- ;
- LSTPRD ;get dates for the last 365 and 90- day period
- S DTSTR=DGRET(I,DGCLCK(I))
- S DGSDT365=$P(DGRET(I,1),U),DGEDT365=$$FMADD^XLFDT(DGSDT365,365)
- S DGSDT90=$P(DTSTR,U),DGEDT90=$P(DTSTR,U,2)
- S DGNXT365=$S(DGEDT365<=DT:1,$$FMDIFF^XLFDT(DGEDT90,DGSDT365)>=365:1,(DGSDT90>=DT||DGSDT90<=DT)&(DGEDT90>=DT):0,1:0)
- Q
- ;
- NXT365 ;display verbiage for the next 365-day period
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)=$$NXT2()
- S DGCNTR=DGCNTR+1
- S RET(DGCNTR)="Please contact Registration to start the clock."
- Q
- ;
- NXT2() ;
- Q "Patient is eligible for an additional 90-Day period for the next 365-Day."
- ;
- ;
- ;
- ;/** Set RET for the case when PP category was selected for the patient
- ;Input:
- ; PPIND - returned by $$PPINFO^DGOTHBT2(DGDFN)
- ;Output:
- ; RET - local array to return information to send to CPRS
- ;
- ;*/
- SHOWPP(PPIND,RET) ;
- N DGRET,DGCAT
- S DGRET=$P(PPIND,U,2,3)
- S RET(1)="PP^Presumptive Psychosis Authority, click for details"
- S DGCAT=$P(DGRET,U)
- I DGCAT="OTH" D Q
- . S RET(2)="Fsm^Former Service Member with prior OTH discharge; should now be post-adjudication."
- . S RET(3)="Eligible for mental health care only under Presumptive Psychosis Authority: Former Service Member with"
- . S RET(4)="prior OTH discharge; should now be post-adjudication."
- . S RET(5)="Patients who experienced MST may be eligible for MST-related care; check with Eligibility for specifics."
- . S RET(6)=""
- . S RET(0)=6
- S RET(2)=$E(DGCAT,1,1)_$$LOW^XLFSTR($E(DGCAT,2,3))_U_$P(DGRET,U,2)
- S RET(3)="Eligible for mental health care only under Presumptive Psychosis Authority: "_$P(DGRET,U,2)_"."
- S RET(4)="Patients who experienced MST are eligible for MST related mental health and medical care."
- S RET(0)=4
- Q
- ;
- ;/** Set RET array for the messages to display in CPRS when we have PP workaround settings
- ;Input:
- ; nothing
- ;Output:
- ; RET - local array to return information to send to CPRS
- ;*/
- WORKARND(RET) ;
- S RET(1)="PP^Presumptive Psychosis Authority, click for details"
- S RET(2)="^"
- S RET(3)="Eligible for mental health care only under Presumptive Psychosis Authority."
- S RET(4)="PP Category: No value was selected as PP Indicator is not completed."
- S RET(5)="Patients who experienced MST are eligible for MST related mental health and medical care."
- S RET(0)=5
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHBTN 18452 printed Jan 18, 2025@03:47:25 Page 2
- DGOTHBTN ;SLC/SS,RM,JC - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ; 03/27/2019
- +1 ;;5.3;Registration;**952,977,1029,1035,1047**;Aug 13, 1993;Build 13
- +2 ;
- +3 ;
- +4 ;ICR# TYPE DESCRIPTION
- +5 ;----- ---- ---------------------
- +6 ; 2056 Sup ^DIQ : GETS
- +7 ;10103 Sup ^XLFDT: $$FMADD,$$FMDIFF
- +8 ; 2992 Sup ^XTV(8989.51) access
- +9 ;
- +10 ;Functionality:
- +11 ;This function is called from the "OROTHCL GET" RPC to compose
- +12 ; OTH (Other Than Honorable) status,
- +13 ; PP (Presumptive Psychosis) status,
- +14 ; PRF (Patient Record Flag) and its history
- +15 ; as a text to display in OTH/PP/inactive PRF history button and associated pop-up message in CPRS.
- +16 ;Will be called by OROTHCL code, that is used by ORTHCL GET RPC
- +17 ;See also the DG ICR# 6873 that provides CPRS access to this API.
- +18 ;
- +19 ;Input parameters:
- +20 ; RET - reference type parameter to return data
- +21 ; DGDFN - patient's IEN in the file (#2)
- +22 ; DGDATE - the date to calculate status and compose the text to return to CPRS
- +23 ; default = DT (today)
- +24 ;
- +25 ;ATTENTION: Here below is what the ORTHCL GET RPC is supposed to return to GUI code
- +26 ; (actual return values of this API below not necessarily should be the same
- +27 ; but need to provide all information to support OR M-code that will pass it to the OR RPC)
- +28 ;
- +29 ;Return array:
- +30 ;If RET(0)<0 : error code less than zero^error message - it is an error, and do not display anything
- +31 ;
- +32 ;If RET(0)=0 : then do not display anything in CPRS
- +33 ;
- +34 ;If RET(0)>0 : see the description below:
- +35 ;
- +36 ;RET(0) = number of lines to return
- +37 ;RET(1) = text for the 1st line on the button ^Text to display when hover over the 1st line on the button
- +38 ;RET(2) = text for the 2nd line on the button^Text to display when hover over the 2nd line on the button
- +39 ;RET(3) = text for the 1st line of the button-click popup message ^ Text for the 1st line of the warning popup message (see the example for the OTH-90 below)
- +40 ;RET(>3)= text lines for the rest of the text in the popup message when the user clicks on the button or for the warning popup message
- +41 ;NOTE: empty or null values in array elements greater than 3 will not be displayed on the CPRS side.
- +42 ; Enter at least a blank space in the piece to include a blank line in the displayed text.
- +43 ;
- +44 ;Example for OTH-EXT:
- +45 ;RET(0)=6
- +46 ;RET(1)="OTH-EXT^Other than Honorable, click for details"
- +47 ;RET(2)=" "
- +48 ;RET(3)="Other than Honorable - Extended"
- +49 ;RET(4)="Eligible for Mental Health care only"
- +50 ;RET(5)="Not time limited - pending VBA adjudication"
- +51 ;RET(6)="Adjudication will determine eligibility for continuing care"
- +52 ;
- +53 ;Example for OTH-90 with zero days remaining:
- +54 ;RET(0)=10
- +55 ;RET(1)="OTH^Other than Honorable, click for details"
- +56 ;RET(2)="0D,P1^Zero days remaining in the most recent period"
- +57 ;RET(3)="Other Than Honorable Status"
- +58 ;RET(4)=" "
- +59 ;RET(5)="Zero days remaining in the most recent period^WARNING: EMERGENT MH OTH"
- +60 ;RET(6)="^Zero days remaining in the most recent period."
- +61 ;RET(7)="^Authorization from VISN Chief Medical Officer is required for an additional 90-Day period."
- +62 ;RET(8)=" "
- +63 ;RET(9)="Call Registration team for details."
- +64 ;RET(10)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- +65 ;
- +66 ;Example for OTH-90 with less than 7 days remaining:
- +67 ;RET(0)=10
- +68 ;RET(1)="OTH^Other than Honorable, click for details"
- +69 ;RET(2)="5D,P1^5 day(s) remaining in the current period"
- +70 ;RET(3)="Other Than Honorable Status"
- +71 ;RET(4)=" "
- +72 ;RET(5)="5 day(s) remaining in the current period^WARNING: EMERGENT MH OTH"
- +73 ;RET(6)="^Less than 7 day(s) remaining in the current period."
- +74 ;RET(7)="^Authorization from VISN Chief Medical Officer is required for an additional 90-Day period."
- +75 ;RET(8)=" "
- +76 ;RET(9)="Call Registration team for details."
- +77 ;RET(10)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- +78 ;
- +79 ;Example for OTH-90 with more than 7 days remaining:
- +80 ;RET(0)=8
- +81 ;RET(1)="OTH^Other than Honorable, click for details"
- +82 ;RET(2)="80D,P1^80 day(s) remaining in the current period"
- +83 ;RET(3)="Other Than Honorable Status"
- +84 ;RET(4)=" "
- +85 ;RET(5)="80 day(s) remaining in the current period"
- +86 ;RET(6)=" "
- +87 ;RET(7)="Call Registration Team for Details."
- +88 ;RET(7)=RET(7)_Additional Line 1 if defined in ^XTV(8989.51,IEN,20,1,0)
- +89 ;RET(8)=Additional Line 2 if defined in ^XTV(8989.51,IEN,20,2,0) or it will be a blank line.
- +90 ;RET(9)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- +91 ;
- +92 ;Example for PP workaround settings only:
- +93 ;RET(0)=7
- +94 ;RET(1)="PP^Presumptive Psychosis Authority, click for details"
- +95 ;RET(2)="^"
- +96 ;RET(3)="Eligible for mental health care only under Presumptive Psychosis"
- +97 ;RET(4)="Authority."
- +98 ;RET(5)="PP Category: No value was selected as PP Indicator is not completed."
- +99 ;RET(6)="Patients who experienced MST are eligible for MST related mental"
- +100 ;RET(7)="health and medical care."
- +101 ;
- +102 ;Example for PP workaround settings and PP category:
- +103 ;RET(0)=7
- +104 ;RET(1)="PP^Presumptive Psychosis Authority, click for details"
- +105 ;RET(2)="Fsm^Former Service Member with prior OTH discharge; should now be post-adjudication."
- +106 ;RET(3)="Eligible for mental health care only under Presumptive Psychosis"
- +107 ;RET(4)="Authority: Former Service Member with prior OTH discharge;"
- +108 ;RET(5)="should now be post-adjudication."
- +109 ;RET(6)="Patients who experienced MST may be eligible for MST-related care;"
- +110 ;RET(7)="check with Eligibility for specifics."
- +111 ;
- +112 ;Example for PP category without PP workaround settings (the mailman will be also sent to the DGEN ELIGIBILITY ALERT group in DGOTHBT2):
- +113 ;RET(0)=6
- +114 ;RET(1)="PP^Presumptive Psychosis Authority, click for details"
- +115 ;RET(2)="Dec^VETERAN DECLINES ENROLLMENT"
- +116 ;RET(3)="Eligible for mental health care only under Presumptive Psychosis"
- +117 ;RET(4)="Authority: VETERAN DECLINES ENROLLMENT."
- +118 ;RET(5)="Patients who experienced MST are eligible for MST related mental"
- +119 ;RET(6)="health and medical care." ^
- +120 ;
- +121 ;Example for inactive PRFs:
- +122 ;RET(0)=23
- +123 ;RET(1)="Inactive Flag^Patient has Inactive Flag(s), click to view"
- +124 ;RET(2)=" "
- +125 ;RET(3)="Flag name: HIGH RISK FOR SUICIDE Status: INACTIVE"
- +126 ;RET(4)=" Initial Assigned Date: OCT 12, 2020@16:27:10"
- +127 ;RET(5)=" Originating Site: CAMP MASTER"
- +128 ;RET(6)=" Owner Site: CAMP MASTER"
- +129 ;RET(7)=" CAMP MASTER changes:"
- +130 ;RET(8)=" DATE/TIME: NOV 25, 2020@10:45:44 ACTION: INACTIVATE"
- +131 ;RET(9)=" BAY PINES VAMC changes:"
- +132 ;RET(10)=" DATE/TIME: NOV 25, 2020@10:19:17 ACTION: REACTIVATE"
- +133 ;RET(11)=" CAMP MASTER changes:"
- +134 ;RET(12)=" DATE/TIME: NOV 24, 2020@09:26:06 ACTION: INACTIVATE"
- +135 ;RET(13)=" NEW YORK HHS changes:"
- +136 ;RET(14)=" DATE/TIME: NOV 24, 2020@09:25:30 ACTION: CONTINUE"
- +137 ;RET(15)=" *****additional info is in vista*****"
- +138 ;RET(16)=" "
- +139 ;RET(17)="Flag name: MISSING PATIENT Status: INACTIVE"
- +140 ;RET(18)=" Initial Assigned Date: OCT 12, 2020@16:27:54"
- +141 ;RET(19)=" Originating Site: CAMP MASTER"
- +142 ;RET(20)=" Owner Site: CAMP MASTER"
- +143 ;RET(21)=" CAMP MASTER changes:"
- +144 ;RET(22)=" DATE/TIME: DEC 01, 2020@12:06:47 ACTION: INACTIVATE"
- +145 ;RET(23)=" *****additional info is in vista*****"
- +146 ;
- +147 ;
- OTHBTN(DGDFN,DGDATE,RET) ;
- +1 ;
- +2 NEW DGEXP,PPWRK,PPCAT,PRFINF
- +3 KILL ^TMP($JOB,"DGPRINFO")
- +4 SET PRFINF=$$PRFINFO^DGOTHBT2(DGDFN,"DGPRINFO")
- +5 SET RET(0)=0
- +6 ;check OTH
- +7 SET DGEXP=$$GETEXPR^DGOTHD(DGDFN)
- +8 ;if OTH (and possibly inactive PRF)
- +9 IF DGEXP'=""
- DO OTH(DGEXP,DGDFN,.RET,PRFINF)
- KILL ^TMP($JOB,"DGPRINFO")
- QUIT
- +10 ;check for PP workaround settings
- +11 SET PPWRK=$$PPWRKARN^DGPPAPI(DGDFN)
- +12 ;check for PP category
- +13 SET PPCAT=$$PPINFO^DGPPAPI(DGDFN)
- +14 ;if PP (and possibly inactive PRF)
- +15 IF PPWRK'="N"!(PPCAT'="")
- DO PRESUMP(PPWRK,PPCAT,DGDFN,.RET,PRFINF)
- KILL ^TMP($JOB,"DGPRINFO")
- QUIT
- +16 ;check if PRF
- +17 ;if no inactive PRF then quit
- +18 IF $PIECE(PRFINF,U,3)'="I"
- KILL ^TMP($JOB,"DGPRINFO")
- QUIT
- +19 ;if at least one inactive PRF flag
- +20 DO INPRFONL^DGOTHBT2(DGDFN,"DGPRINFO",.RET)
- +21 KILL ^TMP($JOB,"DGPRINFO")
- +22 ;if nothing then don't display button - RET(0) is already set to 0
- +23 QUIT
- +24 ;
- +25 ;/** Process OTH patient with or without inactive PRF
- +26 ;check for OTH settings and prepare the text for the button and pop-up window
- +27 ;Input:
- +28 ; DGEXP - OTH data from $$GETEXPR^DGOTHD(DGDFN)
- +29 ; DGDFN - IEN in the file (#2)
- +30 ; RET - to return an array with data
- +31 ;Output:
- +32 ; RET(0)=0 - nothing to display
- +33 ;or
- +34 ; RET(0)>0, RET - with data to display on the button
- +35 ;*/
- OTH(DGEXP,DGDFN,RET,PRFINF) ;
- +1 NEW PPRET
- +2 SET RET(0)=0
- +3 ;if error then quit
- +4 IF DGEXP<0
- SET RET(0)=DGEXP
- QUIT
- +5 ;if there are no any inactive PRF
- +6 ;or there are no any inactive PRF that are qualified
- +7 ;then show just OTH information
- +8 IF $PIECE(PRFINF,U,3)'="I"!($$QUALINACT^DGOTHBT2("DGPRINFO",DGDFN)=0)
- Begin DoDot:1
- +9 IF DGEXP'?1"OTH".E
- SET RET(0)=0
- QUIT
- +10 ;determine the OTH type
- +11 IF $$ISOTH^DGOTHD(DGEXP)>1
- Begin DoDot:2
- +12 ;set RET for OTH-90 and return
- +13 DO OTH90(DGDFN,.RET)
- End DoDot:2
- QUIT
- +14 ;if OTH-EXT then set RET for OTH-EXT
- +15 SET RET(0)=11
- +16 SET RET(1)="OTH-EXT^Other than Honorable, click for details"
- +17 SET RET(2)=" "
- +18 SET RET(3)="Other than Honorable - Extended"
- +19 SET RET(4)=" "
- +20 SET RET(5)="Eligible for Mental Health care only unless Veteran has positive MST screen."
- +21 SET RET(6)=" "
- +22 SET RET(7)="If MST Screen is positive, Veteran is eligible for MST related mental health and medical care."
- +23 SET RET(8)="Please review MST checkbox or complete MST screening."
- +24 SET RET(9)=" "
- +25 SET RET(10)="Not time limited - pending VBA adjudication."
- +26 SET RET(11)="Adjudication will determine eligibility for continuing care."
- +27 QUIT
- End DoDot:1
- QUIT
- +28 ;if at least one inactive PRF
- +29 DO OTHINPRF^DGOTHBT2(DGDFN,DGEXP,"DGPRINFO",.RET)
- +30 QUIT
- +31 ;
- +32 ;/**
- +33 ;process PP patient with or without inactive PRF
- +34 ;check for PP settings and prepare the text for the button and pop-up window
- +35 ;Input:
- +36 ; WRKARND - PP work around data from $$PPWRKARN^DGOTHBT2(DGDFN)
- +37 ; PPIND - PP category data from $$PPINFO^DGOTHBT2(DGDFN)
- +38 ; DGDFN - IEN in the file (#2)
- +39 ; RET - to return an array with data
- +40 ;Output:
- +41 ; RET(0)=0 - nothing to display
- +42 ;or
- +43 ; RET(0)>0, RET - with data to display on the button
- +44 ;*/
- PRESUMP(WRKARND,PPIND,DGDFN,RET,PRFINF) ;
- +1 NEW PPRET
- +2 SET RET(0)=0
- +3 SET PPRET=$PIECE(PPIND,U,1)
- +4 ;if there are no any inactive PRF
- +5 ;then show just PP information
- +6 Begin DoDot:1
- +7 ;if indicator = NO then we NEVER show PP indicator
- IF PPRET="N"
- QUIT
- +8 ;if no indicator data AND no workaround settings then don't show PP indicator
- IF PPIND=""
- IF WRKARND="N"
- QUIT
- +9 ;if no indicator data BUT workaround settings exist- then set RET to warn the user
- IF PPIND=""
- IF WRKARND="Y"
- DO WORKARND(.RET)
- QUIT
- +10 ;set RET for regular message when PP indicator data exist
- IF PPRET="Y"
- IF WRKARND="Y"
- DO SHOWPP(PPIND,.RET)
- QUIT
- +11 ;set RET for regular message when PP indicator data exist
- IF PPRET="Y"
- IF WRKARND="N"
- DO SHOWPP(PPIND,.RET)
- DO SENDMAIL^DGOTHBT2(DGDFN)
- QUIT
- End DoDot:1
- IF $PIECE(PRFINF,U,3)="I"
- IF $$QUALINACT^DGOTHBT2("DGPRINFO",DGDFN)=1
- DO PRWITHPP^DGOTHBT2(DGDFN,"DGPRINFO",.RET)
- +12 ;if at least one inactive PRF
- +13 QUIT
- +14 ;
- +15 ;
- OTH90(DGDFN,RET) ;calculate the CPRS EMERGENT OTH button
- +1 KILL RET
- +2 NEW DGN,DGIEN33,DGRET,DGCLCK,DGLS365D,DGLS365I,DG90A,DGCNTR,DG90,DGCRNT,LSTDAY
- +3 NEW Z,DTSTR,DGSDT365,DGEDT365,DGSDT90,DGEDT90,DGNXT365,DGARR,DGERR,I,II,ZJMC
- +4 IF $$ISOTHD^DGOTHD(DGDFN)=0
- SET RET(0)="-1^Patient's primary eligibility code is no longer EXPANDED MH CARE NON-ENROLLEE"
- QUIT
- +5 SET DGIEN33=+$ORDER(^DGOTH(33,"B",DGDFN,0))
- +6 IF DGIEN33=0
- SET RET(0)="-1^Unable to find an entry in OTH ELIGIBILITY PATIENT file #33 for this patient"
- QUIT
- +7 DO GETS^DIQ(33,DGIEN33_",",".01;.02;1*;2*","I","DGARR","DGERR")
- +8 IF $DATA(DGERR)
- SET RET(0)="-1^FileMan Error #"_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1)
- QUIT
- +9 IF $GET(DGARR(33,DGIEN33_",",.02,"I"))<1
- SET RET(0)="-1^Patient is no longer Other Than Honorable eligible"
- QUIT
- +10 DO CLOCK^DGOTHRP2(DGIEN33)
- +11 IF DGLS365D'>0
- SET RET(0)="-1^No 365 days clocks started"
- QUIT
- +12 ;check if one of the 365 or 90-day period is missing
- +13 IF $$MSNGPRD(DGLS365D,.DGCLCK)
- QUIT
- +14 DO RESULT^DGOTHRP3(.DGARR,.DGCLCK,DGIEN33)
- +15 IF '$DATA(DGRET)
- SET RET(0)="-1^Check patient's 90-Day period, one of them is missing"
- QUIT
- +16 SET DGCNTR=1
- SET (LSTDAY,DGCRNT)=0
- +17 SET RET(DGCNTR)="OTH^Other than Honorable, click for details"
- +18 SET DGCNTR=DGCNTR+1
- +19 FOR I=1:1:DGLS365D
- Begin DoDot:1
- +20 ;get date for the last 365 and 90-day period
- +21 IF 'DGCRNT
- DO LSTPRD
- +22 if DGCRNT>0
- QUIT
- +23 IF DGRET(I)<1
- IF $DATA(DGRET(I+1))
- QUIT
- +24 SET II=""
- FOR
- SET II=$ORDER(DGRET(I,II))
- if II=""
- QUIT
- Begin DoDot:2
- +25 NEW DG90
- +26 SET DG90=DGRET(I,II)
- +27 IF $PIECE(DG90,U,3)<1
- IF $DATA(DGRET(I,II+1))
- QUIT
- +28 IF $PIECE(DG90,U,2)=DT
- SET LSTDAY=1
- +29 IF DGCNTR=2
- SET DGCRNT=1
- DO BTN
- DO HDR
- DO MST
- +30 IF $PIECE(DG90,U,3)>=7
- IF $PIECE(DG90,U,3)<=90
- Begin DoDot:3
- +31 IF $PIECE(DG90,U)>DT
- DO AUTH1
- QUIT
- +32 SET DGCNTR=DGCNTR+1
- +33 SET RET(DGCNTR)=$$POPUP
- +34 IF '$DATA(DGRET(I,II+1))
- Begin DoDot:4
- +35 IF 'DGNXT365
- DO AUTH1
- QUIT
- +36 DO NXT365
- End DoDot:4
- End DoDot:3
- +37 IF $PIECE(DG90,U,3)<7
- Begin DoDot:3
- +38 ;display warning message
- +39 SET DGCNTR=DGCNTR+1
- +40 SET RET(DGCNTR)=$$POPUP
- +41 DO WARN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +42 SET DGCNTR=DGCNTR+1
- +43 SET RET(DGCNTR)=" "
- +44 SET DGCNTR=DGCNTR+1
- +45 NEW LOCMSG1,LOCMSG2,DIE,DA,DR,ARRAY,DIC,X,LOCIEN,LOCDFLT
- +46 SET LOCDFLT="Call Registration Team for Details. "
- +47 ; ICR 2992 access to ^XTV(8989.51
- +48 SET DIC="^XTV(8989.51,"
- SET DIC(0)="QEZ"
- SET X="OR OTH BTN LOCAL MSG"
- +49 DO ^DIC
- +50 SET LOCIEN=$PIECE($GET(Y),"^")
- +51 DO GETS^DIQ(8989.51,LOCIEN_",","**","","ARRAY")
- +52 SET LOCMSG1=$GET(ARRAY(8989.51,LOCIEN_",","20",1))
- +53 SET LOCMSG2=$GET(ARRAY(8989.51,LOCIEN_",","20",2))
- +54 SET RET(DGCNTR)=$GET(LOCDFLT)_$GET(LOCMSG1)
- SET DGCNTR=DGCNTR+1
- +55 SET RET(DGCNTR)=$GET(LOCMSG2)
- SET DGCNTR=DGCNTR+1
- +56 SET RET(DGCNTR)=" "
- SET DGCNTR=DGCNTR+1
- +57 SET RET(DGCNTR)="Clinician: Determine and document in 1st line of Progress Note if MH treatment related to service."
- +58 SET RET(0)=DGCNTR
- +59 QUIT
- +60 ;
- MSNGPRD(DGLS365D,DGCLCK) ;check if there are 90-Day period missing
- +1 NEW I,II,MSNGPRD
- +2 SET MSNGPRD=0
- +3 FOR I=1:1:DGLS365D
- Begin DoDot:1
- +4 IF '$DATA(DGCLCK(I))
- Begin DoDot:2
- +5 SET RET(0)="-1^The 365-Day period # "_I_" is missing."
- +6 SET MSNGPRD=1
- End DoDot:2
- QUIT
- +7 FOR II=1:1:DGCLCK(I)
- Begin DoDot:2
- +8 IF DGCLCK(I,II)'=II
- Begin DoDot:3
- +9 SET RET(0)="-1^The "_II_$SELECT(II=1:"st",II=2:"nd",II=3:"rd",45[II:"th")_" 90-Day period for the 365 days period # "_I_" is missing."
- +10 SET MSNGPRD=1
- End DoDot:3
- End DoDot:2
- if MSNGPRD
- QUIT
- End DoDot:1
- if MSNGPRD
- QUIT
- +11 QUIT MSNGPRD
- +12 ;
- MST ;Text for MST information.
- +1 SET DGCNTR=DGCNTR+1
- +2 SET RET(DGCNTR)="Eligible for MH care only. Remember to perform MST screen."
- +3 SET DGCNTR=DGCNTR+1
- +4 SET RET(DGCNTR)=" "
- +5 QUIT
- +6 ;
- BTN ;Text to be displayed in the button and when user hover the button
- +1 ;
- +2 SET RET(DGCNTR)=$SELECT($GET(LSTDAY):"LD",1:$PIECE(DG90,U,3)_"D")_",P"_II_"^"_$$POPUP()
- +3 QUIT
- +4 ;
- HDR ;display popup message header
- +1 SET DGCNTR=DGCNTR+1
- +2 SET RET(DGCNTR)="Other Than Honorable Status"
- +3 SET DGCNTR=DGCNTR+1
- +4 SET RET(DGCNTR)=" "
- +5 QUIT
- +6 ;
- +1 QUIT $SELECT($GET(LSTDAY):$$LSTDAY(),$PIECE(DG90,U,3)=0:"Zero days remaining ",1:$PIECE(DG90,U,3)_" day(s) remaining ")_"in the "_$$MSG()_" period"
- +2 ;
- AUTH1 ;Display authorization verbiage in the popup message
- +1 IF $PIECE(DG90,U,4)=""
- Begin DoDot:1
- +2 IF $PIECE(DG90,U)>DT
- SET DGCNTR=DGCNTR+1
- DO AUTH3
- QUIT
- +3 SET DGCNTR=DGCNTR+1
- +4 SET RET(DGCNTR)="Authorization required for further care."
- End DoDot:1
- QUIT
- +5 IF DGSDT90<=DT
- Begin DoDot:1
- +6 SET DGCNTR=DGCNTR+1
- +7 SET RET(DGCNTR)=$$AUTH2()
- End DoDot:1
- QUIT
- +8 SET DGCNTR=DGCNTR+1
- +9 DO AUTH3
- +10 QUIT
- +11 ;
- LSTDAY() ;
- +1 QUIT "Last day patient is eligible for treatment "
- +2 ;
- AUTH2() ;
- +1 QUIT "Authorization from VISN Chief Medical Officer is required for an additional 90-Day period."
- +2 ;
- AUTH3 ;
- +1 SET RET(DGCNTR)=$PIECE(DG90,U,3)_" day(s) are authorized starting on "_$$FMTE^XLFDT($PIECE(DG90,U))
- +2 QUIT
- MSG() ;
- +1 QUIT $SELECT($GET(LSTDAY):"current",(('DGNXT365)&(DGRET(I)>0)):"current",1:"most recent")
- +2 ;
- WARN ;display warning message when user selects a patient less than 7 day(s) remaining.
- +1 SET RET(DGCNTR)=RET(DGCNTR)_"^WARNING: EMERGENT MH OTH"
- +2 SET DGCNTR=DGCNTR+1
- +3 SET RET(DGCNTR)=$SELECT($GET(LSTDAY):"^"_$$LSTDAY(),$PIECE(DG90,U,3)=0:"^Zero days remaining ",1:"^Less than 7 day(s) remaining ")_"in the "_$$MSG()_" period."
- +4 IF 'DGNXT365
- Begin DoDot:1
- +5 IF DGSDT90<=DT
- Begin DoDot:2
- +6 SET DGCNTR=DGCNTR+1
- +7 SET RET(DGCNTR)="^"_$$AUTH2()
- +8 IF $PIECE(DG90,U,3)<7
- SET RET(DGCNTR+1)=$PIECE(RET(DGCNTR),U,2)
- SET DGCNTR=DGCNTR+1
- End DoDot:2
- End DoDot:1
- QUIT
- +9 IF '$TEST
- Begin DoDot:1
- +10 IF '$DATA(DGRET(I,II+1))
- Begin DoDot:2
- +11 SET DGCNTR=DGCNTR+1
- +12 SET RET(DGCNTR)="^"_$$NXT2()
- +13 DO NXT365
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- LSTPRD ;get dates for the last 365 and 90- day period
- +1 SET DTSTR=DGRET(I,DGCLCK(I))
- +2 SET DGSDT365=$PIECE(DGRET(I,1),U)
- SET DGEDT365=$$FMADD^XLFDT(DGSDT365,365)
- +3 SET DGSDT90=$PIECE(DTSTR,U)
- SET DGEDT90=$PIECE(DTSTR,U,2)
- +4 SET DGNXT365=$SELECT(DGEDT365<=DT:1,$$FMDIFF^XLFDT(DGEDT90,DGSDT365)>=365:1,(DGSDT90>=DT||DGSDT90<=DT)&(DGEDT90>=DT):0,1:0)
- +5 QUIT
- +6 ;
- NXT365 ;display verbiage for the next 365-day period
- +1 SET DGCNTR=DGCNTR+1
- +2 SET RET(DGCNTR)=$$NXT2()
- +3 SET DGCNTR=DGCNTR+1
- +4 SET RET(DGCNTR)="Please contact Registration to start the clock."
- +5 QUIT
- +6 ;
- NXT2() ;
- +1 QUIT "Patient is eligible for an additional 90-Day period for the next 365-Day."
- +2 ;
- +3 ;
- +4 ;
- +5 ;/** Set RET for the case when PP category was selected for the patient
- +6 ;Input:
- +7 ; PPIND - returned by $$PPINFO^DGOTHBT2(DGDFN)
- +8 ;Output:
- +9 ; RET - local array to return information to send to CPRS
- +10 ;
- +11 ;*/
- SHOWPP(PPIND,RET) ;
- +1 NEW DGRET,DGCAT
- +2 SET DGRET=$PIECE(PPIND,U,2,3)
- +3 SET RET(1)="PP^Presumptive Psychosis Authority, click for details"
- +4 SET DGCAT=$PIECE(DGRET,U)
- +5 IF DGCAT="OTH"
- Begin DoDot:1
- +6 SET RET(2)="Fsm^Former Service Member with prior OTH discharge; should now be post-adjudication."
- +7 SET RET(3)="Eligible for mental health care only under Presumptive Psychosis Authority: Former Service Member with"
- +8 SET RET(4)="prior OTH discharge; should now be post-adjudication."
- +9 SET RET(5)="Patients who experienced MST may be eligible for MST-related care; check with Eligibility for specifics."
- +10 SET RET(6)=""
- +11 SET RET(0)=6
- End DoDot:1
- QUIT
- +12 SET RET(2)=$EXTRACT(DGCAT,1,1)_$$LOW^XLFSTR($EXTRACT(DGCAT,2,3))_U_$PIECE(DGRET,U,2)
- +13 SET RET(3)="Eligible for mental health care only under Presumptive Psychosis Authority: "_$PIECE(DGRET,U,2)_"."
- +14 SET RET(4)="Patients who experienced MST are eligible for MST related mental health and medical care."
- +15 SET RET(0)=4
- +16 QUIT
- +17 ;
- +18 ;/** Set RET array for the messages to display in CPRS when we have PP workaround settings
- +19 ;Input:
- +20 ; nothing
- +21 ;Output:
- +22 ; RET - local array to return information to send to CPRS
- +23 ;*/
- WORKARND(RET) ;
- +1 SET RET(1)="PP^Presumptive Psychosis Authority, click for details"
- +2 SET RET(2)="^"
- +3 SET RET(3)="Eligible for mental health care only under Presumptive Psychosis Authority."
- +4 SET RET(4)="PP Category: No value was selected as PP Indicator is not completed."
- +5 SET RET(5)="Patients who experienced MST are eligible for MST related mental health and medical care."
- +6 SET RET(0)=5
- +7 QUIT
- +8 ;