DGOTHINQ ;SLC/RM,RED - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ; August 03,2018@13:16
;;5.3;Registration;**952,1016**;Aug 13, 1993;Build 6
;
;
; Last Edited: SHRPE/RED - May 2,2019
;
; ICR# TYPE DESCRIPTION
;----- ---- -------------------------------
; 2056 Sup GETS^DIQ,GET1^DIQ
; 10103 Sup ^XLFDT: $$FMTE, $$NOW, $$FMADD, $$FMDIFF
; 10061 Sup DEM^VADPT
; 10026 Sup ^DIR
;
Q ;No direct access
;
;This option will display the Other Than Honorable Patient countdown clock demographics
;Entry point DG OTH PATIENT INQ option
;
EN ;
N DGLOOP,POP,OTH90,DGRET,DGOTHIST
S (POP,DGLOOP)=0
F D Q:DGLOOP=1!(POP=1)
. N DGIEN33,DFN,DGPTNM
. W !
. S DGPTNM=$$SELPAT(.DGARR),DGIEN33=DGARR
. I DGIEN33<0 S DGLOOP=1 Q
. D PATDISP Q
Q
;
PATDISP ;Entry point from DG OTH MANAGEMENT Option
N DGARR,DG90A,DGFLG,DGSTAT,DGRES,DGRQAUT,DGLS365D,DGLS365I,DGIEN332,DGPTTYP,DGRET,DGNOT,DGOTHIST,HISFLAG
S (DGFLG,DGSTAT,DGNOT,HISFLAG)=0,(DGPTTYP,DGRQAUT)=""
S OTH90=$$CROSS(DGIEN33,.DGOTHIST)
S DFN=$$GETPAT^DGOTHD2(DGIEN33)
W @IOF
D GETS^DIQ(33,DGIEN33_",",".01;.02;.05;1*","EI","DGARR","DGERR")
D CLOCK(DGIEN33)
S DGSTAT=$$STATUS(.DGARR) ;Get status if they have a 90 day clock
I ('$D(DG90A))!('$D(DG90A(1))) D HEADER(DFN,DGSTAT),HIST Q
S DGRES=$$RESULT(.DGARR,.DG90A,DGIEN33)
I DGRES<0 W !!,"Error"_$S($L($P(DGRES,U,2))>0:": "_$P(DGRES,U,2),1:""),!,"Please select another patient.",! Q
I $D(DG90A(1)),'$D(DG90A(2)),$P(OTH90,U,2)="OTH-90" D Q
. D HEADER(DFN,DGSTAT)
. I DGSTAT=3 D HIST Q ;No longer an OTH patient, display history and quit
. W !
. I DGLS365D<1 S DGIEN332=+$O(^DGOTH(33,DGIEN33,2,999999999),-1),DGPTTYP=$P($G(^DGOTH(33,DGIEN33,2,DGIEN332,0)),U,3) I DGPTTYP'="" W !!,"OTH patient type: ",$$GET1^DIQ(33.02,DGIEN332_","_DGIEN33_",",".03")
. D DSPLY4(1),DSPLY5(DGRES,1),HIST
. I 23[DGSTAT D MSG(DGSTAT,.DGARR,DGIEN33) Q
I $D(DG90A(1)),$D(DG90A(2)),$P(OTH90,U,2)="OTH-90" D
. Q:$G(DGRQAUT)=""
. I $P(DGRES,U,$L(DGRES,U))="" D Q ;last period not defined completely
. . D HEADER(DFN,DGSTAT) W !!
. . D PRNTD(DGRES),HIST
. . S DGFLG=1
. . W ?30,"Date request submitted: ",$S($G(DGRQAUT)'="":$$FMTE^XLFDT(DGRQAUT,"5Z"),1:"N/A"),!!
. . I 23[DGSTAT D MSG(DGSTAT,.DGARR,DGIEN33) Q
Q:DGFLG
D HEADER(DFN,DGSTAT) I DGSTAT=3 D HIST W !!
I $P(OTH90,U,2)="OTH-90" D PRNTD(DGRES),HIST
I 'HISFLAG D HIST
Q
;
PRNTD(DGRES) ;print OTH patient countdown clock demographics
N I,DGCLCK
S DGCLCK=+$O(DG90A(9),-1)
F I=1:1:DGCLCK D
. D DSPLY4(I),DSPLY5(DGRES,I)
Q
;
MSG(DGSTAT,DGARR,DGIEN33) ;display inactivation/adjudication message
N DGRSN,DGLSDT,DGRSNIN
W !
S DGLSDT=$O(^DGOTH(33,DGIEN33,2,"B","A"),-1) Q:DGLSDT<1
S DGRSNIN=$O(^DGOTH(33,DGIEN33,2,"B",DGLSDT,999),-1)
S DGRSN=$$GET1^DIQ(33.02,DGRSNIN_","_DGIEN33_",",".04")
I DGRSN="" S DGRSN=$$GET1^DIQ(33,DGIEN33_",",".04")
I 3[DGSTAT W !?10,"** INACTIVE **"
Q
;
N DDASH,DGNAME,DGDOB,VADM,DGSSN,DGIEN332 S DGIEN332=0
D DEM^VADPT ;get patient demographics
S DGNAME=VADM(1),DGDOB=$P(VADM(3),U),DGSSN=$P($P(VADM(2),U,2),"-",3)
W ?19,"OTHER THAN HONORABLE PATIENT INQUIRY"
W !,"Patient Name: ",DGNAME," (",DGSSN,") ",?57,"DOB: ",$$FMTE^XLFDT(DGDOB)
S $P(DDASH,"=",81)="" W !,DDASH ;write dash lines
W !?12,"OTHER THAN HONORABLE STATUS: ",$S(DGSTAT=1:"ACTIVE",DGSTAT=2:"**PENDING**",DGSTAT=3:" **INACTIVE**",1:"")," "
W !?20,"CURRENT ELIGIBILITY: ",$S($$OTHTYP($P(OTH90,U,2)):"Expanded MH/"_$P(OTH90,U,2),1:$P(OTH90,U,2)),!
Q
;
RESULT(DGARR,DG90A,DGIEN33) ;get the result for OTH patient
N DGIENS,DGDATE,I,II,DGAUTH
S DGRES=""
S DGDATE=$S($G(DGDATE)>0:DGDATE,1:DT)
S I=DGLS365D D
. S DGRET(I)="",DGRQAUT=""
. F II=1:1:DGCLCK(I) D
. . N DGSDT,DGENDT,DGDIFF,DATASTR
. . S DGIENS=DGCLCK(I,II)_","_I_","_+DGIEN33_","
. . S DATASTR=$$GET90DT^DGOTHUT1(+DGIEN33,I,II)
. . S DGSDT=$P(DATASTR,U) ;start date
. . S DGENDT=$P(DATASTR,U,2) ;end date
. . S DGDIFF=$P(DATASTR,U,3) ;days remaining
. . S DGAUTH=DGARR(33.11,DGIENS,.04,"I")
. . S DGRES=DGRES_DGSDT_U_DGENDT_U_DGDIFF_U
. . S DGRET(I,II)=DGSDT_U_DGENDT_U_DGDIFF_U_DGAUTH
. . I $P(DGRET(I,II),U)="",$P(DGRET(I,II),U,2)="" S DGRQAUT=$G(DGARR(33.11,DGIENS,.1,"I"))
. . ;determine which clock is considered "active" within the current 365-Day period
. . S DGRET(I)=II
. . I DGDIFF>0,DGDIFF<90,DGSDT<=DT,DGAUTH S DGRET(I)=II
Q DGRES
;
DSPLY4(CLCKNO) ;
I CLCKNO=1 W " 365 Day Period: ",$S(DGLS365D=1:DGLS365D,1:DGLS365D_" *"),!!," 90 Day Period: ",CLCKNO Q
W !!," 90 Day Period: ",CLCKNO
Q
;
DSPLY5(DGRES,CLCKNO) ;
N OTHSMRY,SEQ
I CLCKNO=1 D
. S OTHSMRY(CLCKNO,1)=$S($P(DGRES,U,1)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,1),"5Z")) ;start date
. S OTHSMRY(CLCKNO,2)=$S($P(DGRES,U,2)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,2),"5Z")) ;end date
. S OTHSMRY(CLCKNO,3)=$S($P(DGRES,U,3)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,3))) ;days remaining
I CLCKNO=2 D
. S OTHSMRY(CLCKNO,1)=$S($P(DGRES,U,4)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,4),"5Z")) ;start date
. S OTHSMRY(CLCKNO,2)=$S($P(DGRES,U,5)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,5),"5Z")) ;end date
. S OTHSMRY(CLCKNO,3)=$S($P(DGRES,U,6)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,6))) ;days remaining
I CLCKNO=3 D
. S OTHSMRY(CLCKNO,1)=$S($P(DGRES,U,7)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,7),"5Z")) ;start date
. S OTHSMRY(CLCKNO,2)=$S($P(DGRES,U,8)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,8),"5Z")) ;end date
. S OTHSMRY(CLCKNO,3)=$S($P(DGRES,U,9)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,9))) ;days remaining
I CLCKNO=4 D
. S OTHSMRY(CLCKNO,1)=$S($P(DGRES,U,10)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,10),"5Z")) ;start date
. S OTHSMRY(CLCKNO,2)=$S($P(DGRES,U,11)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,11),"5Z")) ;end date
. S OTHSMRY(CLCKNO,3)=$S($P(DGRES,U,12)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,12))) ;days remaining
I CLCKNO=5 D
. S OTHSMRY(CLCKNO,1)=$S($P(DGRES,U,13)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,13),"5Z")) ;start date
. S OTHSMRY(CLCKNO,2)=$S($P(DGRES,U,14)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,14),"5Z")) ;end date
. S OTHSMRY(CLCKNO,3)=$S($P(DGRES,U,15)="":" ",1:$$FMTE^XLFDT($P(DGRES,U,15))) ;days remaining
;
S SEQ="" F S SEQ=$O(OTHSMRY(CLCKNO,SEQ)) Q:SEQ=""!(SEQ>5) D
. I SEQ=1,OTHSMRY(CLCKNO,SEQ)=" " W " (*Pending*)" S SEQ=99 Q
. I SEQ=1 W !?5,"Start Date: ",OTHSMRY(CLCKNO,SEQ)
. I SEQ=2 W ?30,"End Date: ",OTHSMRY(CLCKNO,SEQ)
. I SEQ=3 W ?55,"Days Remaining: ",$S(OTHSMRY(CLCKNO,SEQ)'="":OTHSMRY(CLCKNO,SEQ),1:"0")
. Q
I '$D(DG90A(CLCKNO+1)),$G(DGARR(33,DGIEN33_",",.05,"I"))'="" W !!?8,"Pending Auth request submitted: ",$P($$FMTE^XLFDT($G(DGARR(33,DGIEN33_",",.05,"I")),"5Z"),"@") Q
K OTHSMRY
Q
;
HIST ; display the history of the PE/EXP changes
N DGLINE S $P(DDASH,"-",81)=""
W !!?15,"Primary Eligibility/Expanded Care Type History",!
I $D(DGOTHIST)=0 W DDASH,!,"None on file" Q
W DDASH,"Primary Eligibility",?35,"Expanded Care",?50,"Date of",?65,"Division",!,?35,"Type",?50,"Change",!,DDASH
N J S J="" F S J=$O(DGOTHIST(DGIEN33,J)) Q:J="" D
. S DGLINE=DGOTHIST(DGIEN33,J)
. Q:$P(DGLINE,U)="" ;!($P(DGLINE,U)["EXPANDED")
. W !,$S($P(DGLINE,U)="":"N/A",$$OTHTYP($P(DGLINE,U)):"EXPANDED MH CARE NON-ENROLLEE",1:$P(DGLINE,U))
. W ?35,$S(($P(DGLINE,U)=""!('$$OTHTYP($P(DGLINE,U)))):"N/A",1:$P(DGLINE,U))
. W ?50,$$FMTE^XLFDT($P(DGLINE,U,2),"5Z"),?65,$$STA^XUAF4($P(DGLINE,U,3))
S HISFLAG=1 ;History has been displayed
Q
STATUS(DGARR) ; return OTH patient status DG*5.3*1016
N DGPSTAT
S DGPSTAT=0
D
.;ACTIVE
.I $G(DGARR(33,DGIEN33_",",.02,"I"))=1 D
..I $G(DGARR(33,DGIEN33_",",.05,"I"))=""!($P(OTH90,U,2)="OTH-EXT") S DGPSTAT=1 Q
..;PENDING AUTHORIZATION
..I $G(DGARR(33,DGIEN33_",",.05,"I"))'="" S DGPSTAT=2
..Q
.;INACTIVE
.I '$G(DGARR(33,DGIEN33_",",.02,"I")) S DGPSTAT=3
.Q
Q DGPSTAT
;
CLOCK(DGIEN33) ;
N DGN
S DGLS365D=+$O(^DGOTH(33,DGIEN33,1,"B",999),-1)
S DGLS365I=+$O(^DGOTH(33,DGIEN33,1,"B",DGLS365D,0))
F I=DGLS365I:1:DGLS365D D
. S DGN=0 F S DGN=+$O(^DGOTH(33,DGIEN33,1,I,1,"B",DGN)) Q:DGN=0 D
. . S DG90A(DGN)=+$O(^DGOTH(33,DGIEN33,1,I,1,"B",DGN,0))
. . S DGCLCK(I)=DGN,DGCLCK(I,DGN)=+$O(^DGOTH(33,DGIEN33,1,I,1,"B",DGN,0))
Q
;
SELPAT(DGPAT) ;
;- input vars for ^DIC call
N DIC,DTOUT,DUOUT,X,Y
S DIC="^DGOTH(33,",DIC(0)="AEMQZV"
S DIC("?PARAM",33,"INDEX")=.01
;- lookup patient
D ^DIC K DIC
;- result of lookup
S DGPAT=Y
;- if success, setup return array using output vars from ^DIC call
I (+DGPAT>0) D Q Y(0,0) ;patient name
. S DGPAT=+Y ;patient ien
. S DGPAT(0)=$G(Y(0)) ;zero node of patient in (#33) file
Q -1
;
CROSS(DGIEN33,DGOTHIST) ;
;Input IEN of file #33
; Returns a count if a history of changes to OTH status are on file for the patient, in reverse order, newest first
; latest entry ^ current OTH type ^ date of change ^ 1
; or if they are no longer an OTH-90 patient - Last entry ^ New Primary Eligibility code ^ Date of change ^ 0
; and an array DGOTHIST(ien,-sequence) = OTH patient type, the last entry is the current value
; or returns 0
N DGTYP,DGCNT,DGNEW,DGNEWN,DGVAL,DGCHDT,DGHIST,LAST,ACTIVE,SUBTYP,DGFAC S DGCNT=0 K DGOTHIST
I '$D(^DGOTH(33,DGIEN33,0))="" Q 0_U_"Invalid Patient"
I $D(^DGOTH(33,DGIEN33,2))=0 Q 0 ;No eligibility data changes in file 33
S LAST=$P(^DGOTH(33,DGIEN33,2,0),U,4) I '$G(LAST) Q 0_$$GET1^DIQ(33,DGIEN33_",",".02","I")
F DGCNT=LAST:-1:1 D
. S DGCHDT=$P($$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".01","I"),"."),DGNEWN=$$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".02")
. S SUBTYP=$$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".03","I"),ACTIVE=$$GET1^DIQ(33,DGIEN33_",",".02","I"),DGFAC=$$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".05","I")
. I $G(SUBTYP)'="" S DGNEWN=SUBTYP
. I DGNEWN="" S DGNEWN="*NONE*"
. I DGCNT=LAST S DGVAL=DGCNT_U_DGNEWN_U_DGCHDT_U_ACTIVE ;(Set main return value)
. S DGOTHIST(DGIEN33,-DGCNT)=DGNEWN_U_DGCHDT_U_DGFAC ;Set history return array)
. Q
I $D(DGVAL) Q DGVAL
Q 0
;
OTHTYP(OTHCTYP) ;Extract OTHER THAN HONORABLE set of codes
;
; Input : None
; Output: The internal set of code value
;
N DGERR,I,DGOTHSOC,YY,TRUE
S TRUE=0
S DGOTHSOC=$$GET1^DID(2,.5501,,"SET OF CODES",,"DGERR")
Q:$D(DGERR)
F I=1:1:$L(DGOTHSOC,";") S YY=$P($P(DGOTHSOC,";",I),":") Q:YY="" I YY=OTHCTYP S TRUE=1
Q TRUE
;end of routine DGOTHINQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHINQ 10438 printed Jan 18, 2025@03:47:34 Page 2
DGOTHINQ ;SLC/RM,RED - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ; August 03,2018@13:16
+1 ;;5.3;Registration;**952,1016**;Aug 13, 1993;Build 6
+2 ;
+3 ;
+4 ; Last Edited: SHRPE/RED - May 2,2019
+5 ;
+6 ; ICR# TYPE DESCRIPTION
+7 ;----- ---- -------------------------------
+8 ; 2056 Sup GETS^DIQ,GET1^DIQ
+9 ; 10103 Sup ^XLFDT: $$FMTE, $$NOW, $$FMADD, $$FMDIFF
+10 ; 10061 Sup DEM^VADPT
+11 ; 10026 Sup ^DIR
+12 ;
+13 ;No direct access
QUIT
+14 ;
+15 ;This option will display the Other Than Honorable Patient countdown clock demographics
+16 ;Entry point DG OTH PATIENT INQ option
+17 ;
EN ;
+1 NEW DGLOOP,POP,OTH90,DGRET,DGOTHIST
+2 SET (POP,DGLOOP)=0
+3 FOR
Begin DoDot:1
+4 NEW DGIEN33,DFN,DGPTNM
+5 WRITE !
+6 SET DGPTNM=$$SELPAT(.DGARR)
SET DGIEN33=DGARR
+7 IF DGIEN33<0
SET DGLOOP=1
QUIT
+8 DO PATDISP
QUIT
End DoDot:1
if DGLOOP=1!(POP=1)
QUIT
+9 QUIT
+10 ;
PATDISP ;Entry point from DG OTH MANAGEMENT Option
+1 NEW DGARR,DG90A,DGFLG,DGSTAT,DGRES,DGRQAUT,DGLS365D,DGLS365I,DGIEN332,DGPTTYP,DGRET,DGNOT,DGOTHIST,HISFLAG
+2 SET (DGFLG,DGSTAT,DGNOT,HISFLAG)=0
SET (DGPTTYP,DGRQAUT)=""
+3 SET OTH90=$$CROSS(DGIEN33,.DGOTHIST)
+4 SET DFN=$$GETPAT^DGOTHD2(DGIEN33)
+5 WRITE @IOF
+6 DO GETS^DIQ(33,DGIEN33_",",".01;.02;.05;1*","EI","DGARR","DGERR")
+7 DO CLOCK(DGIEN33)
+8 ;Get status if they have a 90 day clock
SET DGSTAT=$$STATUS(.DGARR)
+9 IF ('$DATA(DG90A))!('$DATA(DG90A(1)))
DO HEADER(DFN,DGSTAT)
DO HIST
QUIT
+10 SET DGRES=$$RESULT(.DGARR,.DG90A,DGIEN33)
+11 IF DGRES<0
WRITE !!,"Error"_$SELECT($LENGTH($PIECE(DGRES,U,2))>0:": "_$PIECE(DGRES,U,2),1:""),!,"Please select another patient.",!
QUIT
+12 IF $DATA(DG90A(1))
IF '$DATA(DG90A(2))
IF $PIECE(OTH90,U,2)="OTH-90"
Begin DoDot:1
+13 DO HEADER(DFN,DGSTAT)
+14 ;No longer an OTH patient, display history and quit
IF DGSTAT=3
DO HIST
QUIT
+15 WRITE !
+16 IF DGLS365D<1
SET DGIEN332=+$ORDER(^DGOTH(33,DGIEN33,2,999999999),-1)
SET DGPTTYP=$PIECE($GET(^DGOTH(33,DGIEN33,2,DGIEN332,0)),U,3)
IF DGPTTYP'=""
WRITE !!,"OTH patient type: ",$$GET1^DIQ(33.02,DGIEN332_","_DGIEN33_",",".03")
+17 DO DSPLY4(1)
DO DSPLY5(DGRES,1)
DO HIST
+18 IF 23[DGSTAT
DO MSG(DGSTAT,.DGARR,DGIEN33)
QUIT
End DoDot:1
QUIT
+19 IF $DATA(DG90A(1))
IF $DATA(DG90A(2))
IF $PIECE(OTH90,U,2)="OTH-90"
Begin DoDot:1
+20 if $GET(DGRQAUT)=""
QUIT
+21 ;last period not defined completely
IF $PIECE(DGRES,U,$LENGTH(DGRES,U))=""
Begin DoDot:2
+22 DO HEADER(DFN,DGSTAT)
WRITE !!
+23 DO PRNTD(DGRES)
DO HIST
+24 SET DGFLG=1
+25 WRITE ?30,"Date request submitted: ",$SELECT($GET(DGRQAUT)'="":$$FMTE^XLFDT(DGRQAUT,"5Z"),1:"N/A"),!!
+26 IF 23[DGSTAT
DO MSG(DGSTAT,.DGARR,DGIEN33)
QUIT
End DoDot:2
QUIT
End DoDot:1
+27 if DGFLG
QUIT
+28 DO HEADER(DFN,DGSTAT)
IF DGSTAT=3
DO HIST
WRITE !!
+29 IF $PIECE(OTH90,U,2)="OTH-90"
DO PRNTD(DGRES)
DO HIST
+30 IF 'HISFLAG
DO HIST
+31 QUIT
+32 ;
PRNTD(DGRES) ;print OTH patient countdown clock demographics
+1 NEW I,DGCLCK
+2 SET DGCLCK=+$ORDER(DG90A(9),-1)
+3 FOR I=1:1:DGCLCK
Begin DoDot:1
+4 DO DSPLY4(I)
DO DSPLY5(DGRES,I)
End DoDot:1
+5 QUIT
+6 ;
MSG(DGSTAT,DGARR,DGIEN33) ;display inactivation/adjudication message
+1 NEW DGRSN,DGLSDT,DGRSNIN
+2 WRITE !
+3 SET DGLSDT=$ORDER(^DGOTH(33,DGIEN33,2,"B","A"),-1)
if DGLSDT<1
QUIT
+4 SET DGRSNIN=$ORDER(^DGOTH(33,DGIEN33,2,"B",DGLSDT,999),-1)
+5 SET DGRSN=$$GET1^DIQ(33.02,DGRSNIN_","_DGIEN33_",",".04")
+6 IF DGRSN=""
SET DGRSN=$$GET1^DIQ(33,DGIEN33_",",".04")
+7 IF 3[DGSTAT
WRITE !?10,"** INACTIVE **"
+8 QUIT
+9 ;
+1 NEW DDASH,DGNAME,DGDOB,VADM,DGSSN,DGIEN332
SET DGIEN332=0
+2 ;get patient demographics
DO DEM^VADPT
+3 SET DGNAME=VADM(1)
SET DGDOB=$PIECE(VADM(3),U)
SET DGSSN=$PIECE($PIECE(VADM(2),U,2),"-",3)
+4 WRITE ?19,"OTHER THAN HONORABLE PATIENT INQUIRY"
+5 WRITE !,"Patient Name: ",DGNAME," (",DGSSN,") ",?57,"DOB: ",$$FMTE^XLFDT(DGDOB)
+6 ;write dash lines
SET $PIECE(DDASH,"=",81)=""
WRITE !,DDASH
+7 WRITE !?12,"OTHER THAN HONORABLE STATUS: ",$SELECT(DGSTAT=1:"ACTIVE",DGSTAT=2:"**PENDING**",DGSTAT=3:" **INACTIVE**",1:"")," "
+8 WRITE !?20,"CURRENT ELIGIBILITY: ",$SELECT($$OTHTYP($PIECE(OTH90,U,2)):"Expanded MH/"_$PIECE(OTH90,U,2),1:$PIECE(OTH90,U,2)),!
+9 QUIT
+10 ;
RESULT(DGARR,DG90A,DGIEN33) ;get the result for OTH patient
+1 NEW DGIENS,DGDATE,I,II,DGAUTH
+2 SET DGRES=""
+3 SET DGDATE=$SELECT($GET(DGDATE)>0:DGDATE,1:DT)
+4 SET I=DGLS365D
Begin DoDot:1
+5 SET DGRET(I)=""
SET DGRQAUT=""
+6 FOR II=1:1:DGCLCK(I)
Begin DoDot:2
+7 NEW DGSDT,DGENDT,DGDIFF,DATASTR
+8 SET DGIENS=DGCLCK(I,II)_","_I_","_+DGIEN33_","
+9 SET DATASTR=$$GET90DT^DGOTHUT1(+DGIEN33,I,II)
+10 ;start date
SET DGSDT=$PIECE(DATASTR,U)
+11 ;end date
SET DGENDT=$PIECE(DATASTR,U,2)
+12 ;days remaining
SET DGDIFF=$PIECE(DATASTR,U,3)
+13 SET DGAUTH=DGARR(33.11,DGIENS,.04,"I")
+14 SET DGRES=DGRES_DGSDT_U_DGENDT_U_DGDIFF_U
+15 SET DGRET(I,II)=DGSDT_U_DGENDT_U_DGDIFF_U_DGAUTH
+16 IF $PIECE(DGRET(I,II),U)=""
IF $PIECE(DGRET(I,II),U,2)=""
SET DGRQAUT=$GET(DGARR(33.11,DGIENS,.1,"I"))
+17 ;determine which clock is considered "active" within the current 365-Day period
+18 SET DGRET(I)=II
+19 IF DGDIFF>0
IF DGDIFF<90
IF DGSDT<=DT
IF DGAUTH
SET DGRET(I)=II
End DoDot:2
End DoDot:1
+20 QUIT DGRES
+21 ;
DSPLY4(CLCKNO) ;
+1 IF CLCKNO=1
WRITE " 365 Day Period: ",$SELECT(DGLS365D=1:DGLS365D,1:DGLS365D_" *"),!!," 90 Day Period: ",CLCKNO
QUIT
+2 WRITE !!," 90 Day Period: ",CLCKNO
+3 QUIT
+4 ;
DSPLY5(DGRES,CLCKNO) ;
+1 NEW OTHSMRY,SEQ
+2 IF CLCKNO=1
Begin DoDot:1
+3 ;start date
SET OTHSMRY(CLCKNO,1)=$SELECT($PIECE(DGRES,U,1)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,1),"5Z"))
+4 ;end date
SET OTHSMRY(CLCKNO,2)=$SELECT($PIECE(DGRES,U,2)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,2),"5Z"))
+5 ;days remaining
SET OTHSMRY(CLCKNO,3)=$SELECT($PIECE(DGRES,U,3)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,3)))
End DoDot:1
+6 IF CLCKNO=2
Begin DoDot:1
+7 ;start date
SET OTHSMRY(CLCKNO,1)=$SELECT($PIECE(DGRES,U,4)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,4),"5Z"))
+8 ;end date
SET OTHSMRY(CLCKNO,2)=$SELECT($PIECE(DGRES,U,5)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,5),"5Z"))
+9 ;days remaining
SET OTHSMRY(CLCKNO,3)=$SELECT($PIECE(DGRES,U,6)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,6)))
End DoDot:1
+10 IF CLCKNO=3
Begin DoDot:1
+11 ;start date
SET OTHSMRY(CLCKNO,1)=$SELECT($PIECE(DGRES,U,7)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,7),"5Z"))
+12 ;end date
SET OTHSMRY(CLCKNO,2)=$SELECT($PIECE(DGRES,U,8)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,8),"5Z"))
+13 ;days remaining
SET OTHSMRY(CLCKNO,3)=$SELECT($PIECE(DGRES,U,9)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,9)))
End DoDot:1
+14 IF CLCKNO=4
Begin DoDot:1
+15 ;start date
SET OTHSMRY(CLCKNO,1)=$SELECT($PIECE(DGRES,U,10)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,10),"5Z"))
+16 ;end date
SET OTHSMRY(CLCKNO,2)=$SELECT($PIECE(DGRES,U,11)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,11),"5Z"))
+17 ;days remaining
SET OTHSMRY(CLCKNO,3)=$SELECT($PIECE(DGRES,U,12)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,12)))
End DoDot:1
+18 IF CLCKNO=5
Begin DoDot:1
+19 ;start date
SET OTHSMRY(CLCKNO,1)=$SELECT($PIECE(DGRES,U,13)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,13),"5Z"))
+20 ;end date
SET OTHSMRY(CLCKNO,2)=$SELECT($PIECE(DGRES,U,14)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,14),"5Z"))
+21 ;days remaining
SET OTHSMRY(CLCKNO,3)=$SELECT($PIECE(DGRES,U,15)="":" ",1:$$FMTE^XLFDT($PIECE(DGRES,U,15)))
End DoDot:1
+22 ;
+23 SET SEQ=""
FOR
SET SEQ=$ORDER(OTHSMRY(CLCKNO,SEQ))
if SEQ=""!(SEQ>5)
QUIT
Begin DoDot:1
+24 IF SEQ=1
IF OTHSMRY(CLCKNO,SEQ)=" "
WRITE " (*Pending*)"
SET SEQ=99
QUIT
+25 IF SEQ=1
WRITE !?5,"Start Date: ",OTHSMRY(CLCKNO,SEQ)
+26 IF SEQ=2
WRITE ?30,"End Date: ",OTHSMRY(CLCKNO,SEQ)
+27 IF SEQ=3
WRITE ?55,"Days Remaining: ",$SELECT(OTHSMRY(CLCKNO,SEQ)'="":OTHSMRY(CLCKNO,SEQ),1:"0")
+28 QUIT
End DoDot:1
+29 IF '$DATA(DG90A(CLCKNO+1))
IF $GET(DGARR(33,DGIEN33_",",.05,"I"))'=""
WRITE !!?8,"Pending Auth request submitted: ",$PIECE($$FMTE^XLFDT($GET(DGARR(33,DGIEN33_",",.05,"I")),"5Z"),"@")
QUIT
+30 KILL OTHSMRY
+31 QUIT
+32 ;
HIST ; display the history of the PE/EXP changes
+1 NEW DGLINE
SET $PIECE(DDASH,"-",81)=""
+2 WRITE !!?15,"Primary Eligibility/Expanded Care Type History",!
+3 IF $DATA(DGOTHIST)=0
WRITE DDASH,!,"None on file"
QUIT
+4 WRITE DDASH,"Primary Eligibility",?35,"Expanded Care",?50,"Date of",?65,"Division",!,?35,"Type",?50,"Change",!,DDASH
+5 NEW J
SET J=""
FOR
SET J=$ORDER(DGOTHIST(DGIEN33,J))
if J=""
QUIT
Begin DoDot:1
+6 SET DGLINE=DGOTHIST(DGIEN33,J)
+7 ;!($P(DGLINE,U)["EXPANDED")
if $PIECE(DGLINE,U)=""
QUIT
+8 WRITE !,$SELECT($PIECE(DGLINE,U)="":"N/A",$$OTHTYP($PIECE(DGLINE,U)):"EXPANDED MH CARE NON-ENROLLEE",1:$PIECE(DGLINE,U))
+9 WRITE ?35,$SELECT(($PIECE(DGLINE,U)=""!('$$OTHTYP($PIECE(DGLINE,U)))):"N/A",1:$PIECE(DGLINE,U))
+10 WRITE ?50,$$FMTE^XLFDT($PIECE(DGLINE,U,2),"5Z"),?65,$$STA^XUAF4($PIECE(DGLINE,U,3))
End DoDot:1
+11 ;History has been displayed
SET HISFLAG=1
+12 QUIT
STATUS(DGARR) ; return OTH patient status DG*5.3*1016
+1 NEW DGPSTAT
+2 SET DGPSTAT=0
+3 Begin DoDot:1
+4 ;ACTIVE
+5 IF $GET(DGARR(33,DGIEN33_",",.02,"I"))=1
Begin DoDot:2
+6 IF $GET(DGARR(33,DGIEN33_",",.05,"I"))=""!($PIECE(OTH90,U,2)="OTH-EXT")
SET DGPSTAT=1
QUIT
+7 ;PENDING AUTHORIZATION
+8 IF $GET(DGARR(33,DGIEN33_",",.05,"I"))'=""
SET DGPSTAT=2
+9 QUIT
End DoDot:2
+10 ;INACTIVE
+11 IF '$GET(DGARR(33,DGIEN33_",",.02,"I"))
SET DGPSTAT=3
+12 QUIT
End DoDot:1
+13 QUIT DGPSTAT
+14 ;
CLOCK(DGIEN33) ;
+1 NEW DGN
+2 SET DGLS365D=+$ORDER(^DGOTH(33,DGIEN33,1,"B",999),-1)
+3 SET DGLS365I=+$ORDER(^DGOTH(33,DGIEN33,1,"B",DGLS365D,0))
+4 FOR I=DGLS365I:1:DGLS365D
Begin DoDot:1
+5 SET DGN=0
FOR
SET DGN=+$ORDER(^DGOTH(33,DGIEN33,1,I,1,"B",DGN))
if DGN=0
QUIT
Begin DoDot:2
+6 SET DG90A(DGN)=+$ORDER(^DGOTH(33,DGIEN33,1,I,1,"B",DGN,0))
+7 SET DGCLCK(I)=DGN
SET DGCLCK(I,DGN)=+$ORDER(^DGOTH(33,DGIEN33,1,I,1,"B",DGN,0))
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SELPAT(DGPAT) ;
+1 ;- input vars for ^DIC call
+2 NEW DIC,DTOUT,DUOUT,X,Y
+3 SET DIC="^DGOTH(33,"
SET DIC(0)="AEMQZV"
+4 SET DIC("?PARAM",33,"INDEX")=.01
+5 ;- lookup patient
+6 DO ^DIC
KILL DIC
+7 ;- result of lookup
+8 SET DGPAT=Y
+9 ;- if success, setup return array using output vars from ^DIC call
+10 ;patient name
IF (+DGPAT>0)
Begin DoDot:1
+11 ;patient ien
SET DGPAT=+Y
+12 ;zero node of patient in (#33) file
SET DGPAT(0)=$GET(Y(0))
End DoDot:1
QUIT Y(0,0)
+13 QUIT -1
+14 ;
CROSS(DGIEN33,DGOTHIST) ;
+1 ;Input IEN of file #33
+2 ; Returns a count if a history of changes to OTH status are on file for the patient, in reverse order, newest first
+3 ; latest entry ^ current OTH type ^ date of change ^ 1
+4 ; or if they are no longer an OTH-90 patient - Last entry ^ New Primary Eligibility code ^ Date of change ^ 0
+5 ; and an array DGOTHIST(ien,-sequence) = OTH patient type, the last entry is the current value
+6 ; or returns 0
+7 NEW DGTYP,DGCNT,DGNEW,DGNEWN,DGVAL,DGCHDT,DGHIST,LAST,ACTIVE,SUBTYP,DGFAC
SET DGCNT=0
KILL DGOTHIST
+8 IF '$DATA(^DGOTH(33,DGIEN33,0))=""
QUIT 0_U_"Invalid Patient"
+9 ;No eligibility data changes in file 33
IF $DATA(^DGOTH(33,DGIEN33,2))=0
QUIT 0
+10 SET LAST=$PIECE(^DGOTH(33,DGIEN33,2,0),U,4)
IF '$GET(LAST)
QUIT 0_$$GET1^DIQ(33,DGIEN33_",",".02","I")
+11 FOR DGCNT=LAST:-1:1
Begin DoDot:1
+12 SET DGCHDT=$PIECE($$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".01","I"),".")
SET DGNEWN=$$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".02")
+13 SET SUBTYP=$$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".03","I")
SET ACTIVE=$$GET1^DIQ(33,DGIEN33_",",".02","I")
SET DGFAC=$$GET1^DIQ(33.02,DGCNT_","_DGIEN33_",",".05","I")
+14 IF $GET(SUBTYP)'=""
SET DGNEWN=SUBTYP
+15 IF DGNEWN=""
SET DGNEWN="*NONE*"
+16 ;(Set main return value)
IF DGCNT=LAST
SET DGVAL=DGCNT_U_DGNEWN_U_DGCHDT_U_ACTIVE
+17 ;Set history return array)
SET DGOTHIST(DGIEN33,-DGCNT)=DGNEWN_U_DGCHDT_U_DGFAC
+18 QUIT
End DoDot:1
+19 IF $DATA(DGVAL)
QUIT DGVAL
+20 QUIT 0
+21 ;
OTHTYP(OTHCTYP) ;Extract OTHER THAN HONORABLE set of codes
+1 ;
+2 ; Input : None
+3 ; Output: The internal set of code value
+4 ;
+5 NEW DGERR,I,DGOTHSOC,YY,TRUE
+6 SET TRUE=0
+7 SET DGOTHSOC=$$GET1^DID(2,.5501,,"SET OF CODES",,"DGERR")
+8 if $DATA(DGERR)
QUIT
+9 FOR I=1:1:$LENGTH(DGOTHSOC,";")
SET YY=$PIECE($PIECE(DGOTHSOC,";",I),":")
if YY=""
QUIT
IF YY=OTHCTYP
SET TRUE=1
+10 QUIT TRUE
+11 ;end of routine DGOTHINQ
