DGOTHMGT ;SHRPE/YMG - OTH Management option ;04/30/19
;;5.3;Registration;**952**;Aug 13, 1993;Build 160
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
N DGDFN,DGIEN33,DGSVDDF,DSPMODE,HASREQ
S DSPMODE=0 ; 0 = display approved requests, 1 = display denied requests
S (DGDFN,DGIEN33)=0
; load list template
D EN^VALM("DG OTH MANAGEMENT")
Q
;
HDR ; header code
D BLDHDR(DSPMODE)
Q
;
INIT ; init variables and list array
S VALMBG=1
; save off VALMDDF array data for approved and denied requests
M DGSVDDF("A")=VALMDDF
S DGSVDDF("D","LINE")="LINE^2^4^Line^U^0"
S DGSVDDF("D","SUBMISSION DATE")="SUBMISSION DATE^8^15^Submission date^U^0"
S DGSVDDF("D","COMMENT")="COMMENT^25^55^Authorization comment^U^0"
; build list to display
D SET^VALM10(1,"")
D SET^VALM10(2,$$CJ^XLFSTR("A patient has not been selected. Please select a patient.",80))
S VALMCNT=2
Q
;
HELP ; help code
D FULL^VALM1
W @IOF
W !,"This option allows users to view and enter / edit OTH data."
W !
S VALMBCK="R"
Q
;
EXIT ; exit point
;
D CLEAN^VALM10
D CLEAR^VALM1
Q
;
BLD(DSPMODE) ; build list of requests for display
;
; DSPMODE = 0 for displaying approved requests, DSPMODE = 1 for displaying denied requests
;
N DENIEN,DGIEN365,DGIEN90,Z
D CLEAN^VALM10 S VALMCNT=0
S HASREQ=0 ; set to 1 if there's at least one request on the list
W !!,"Working..."
I DGIEN33'>0 G BLDX
I DSPMODE D G BLDX
.; build list of denied requests
.S Z=0 F S Z=$O(^DGOTH(33,DGIEN33,3,"C",Z)) Q:'Z D
..S DENIEN=+$O(^DGOTH(33,DGIEN33,3,"C",Z,"")) I 'DENIEN Q
..S VALMCNT=$$BLDLND(VALMCNT,DENIEN) I '(VALMCNT#10) W "."
..Q
.Q
; DSPMODE=0, build list of approved requests
S DGIEN365=0 F S DGIEN365=$O(^DGOTH(33,DGIEN33,1,DGIEN365)) Q:'DGIEN365 D
.S DGIEN90=0 F S DGIEN90=$O(^DGOTH(33,DGIEN33,1,DGIEN365,1,DGIEN90)) Q:'DGIEN90 D
..S VALMCNT=$$BLDLNA(VALMCNT,DGIEN365,DGIEN90) I '(VALMCNT#10) W "."
..Q
.Q
;
BLDX ; exit point
I VALMCNT=0 S VALMCNT=$$NOREC(DSPMODE) Q
S HASREQ=1
Q
;
NOREC(DSPMODE) ; show message when display list is empty
;
; DSPMODE = 0 for displaying approved requests, DSPMODE = 1 for displaying denied requests
;
; returns line count in the created array
;
D SET^VALM10(1,"")
D SET^VALM10(2,"")
D SET^VALM10(3,$$SETSTR^VALM1("No "_$S(DSPMODE:"denied",1:"approved")_" requests found.","",26,29))
Q 3
;
BLDLND(LNUM,DENIEN) ; build one denied request line to display
;
; LNUM - last line number
; DENIEN - ien in sub-file 33.03
;
; returns current line number
;
N DATASTR,LINE,LN
S DATASTR=$$GETDEN^DGOTHUT1(DGIEN33,DENIEN)
; build line
S LINE="",LN=LNUM+1
S LINE=$$SETSTR^VALM1($$CJ^XLFSTR(LN,$P(VALMDDF("LINE"),U,3)),LINE,1,3)
S LINE=$$SETFLD^VALM1($$CJ^XLFSTR($$FMTE^XLFDT($P(DATASTR,U,2),"2DZ"),$P(VALMDDF("SUBMISSION DATE"),U,3)),LINE,"SUBMISSION DATE")
S LINE=$$SETFLD^VALM1($E($P(DATASTR,U,3),1,55),LINE,"COMMENT")
D SET^VALM10(LN,LINE,LN)
S @VALMAR@("IDX",LN,LN)=DENIEN
Q LN
;
BLDLNA(LNUM,DGIEN365,DGIEN90) ; build one approved request line to display
;
; LNUM - last line number
; DGIEN365 - ien in sub-file 33.01
; DGIEN90 - ien in sub-file 33.11
;
; returns current line number
;
N AUTH,DATASTR,DGNOW,ENDDT,LINE,LN,NUM90,STARTDT,STATUS
S DATASTR=$$GET90DT^DGOTHUT1(DGIEN33,DGIEN365,DGIEN90)
S ENDDT=$P(DATASTR,U,2)
S DATASTR=$$GETAUTH^DGOTHUT1(DGIEN33,DGIEN365,DGIEN90)
S STARTDT=$P(DATASTR,U,3),NUM90=$P(DATASTR,U,2)
; build line
S LINE="",LN=LNUM+1
S LINE=$$SETSTR^VALM1($$CJ^XLFSTR(LN,$P(VALMDDF("LINE"),U,3)),LINE,1,3)
S LINE=$$SETFLD^VALM1($$CJ^XLFSTR($P(DATASTR,U),$P(VALMDDF("365 DAY NUM"),U,3)),LINE,"365 DAY NUM")
S LINE=$$SETFLD^VALM1($$CJ^XLFSTR(NUM90,$P(VALMDDF("90 DAY NUM"),U,3)),LINE,"90 DAY NUM")
S LINE=$$SETFLD^VALM1($$FMTE^XLFDT(STARTDT,"2DZ"),LINE,"START DATE")
S LINE=$$SETFLD^VALM1($$FMTE^XLFDT(ENDDT,"2DZ"),LINE,"END DATE")
S AUTH=$S(NUM90'>1:"Not required",1:$$FMTE^XLFDT($P(DATASTR,U,5),"2DZ"))
S LINE=$$SETFLD^VALM1(AUTH,LINE,"AUTH")
S DGNOW=$$NOW^XLFDT()
S STATUS=$S(STARTDT>DGNOW:"Not started",ENDDT<DGNOW:"Expired",1:"Active")
S LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
D SET^VALM10(LN,LINE,LN)
S @VALMAR@("IDX",LN,LN)=DGIEN365_U_DGIEN90
Q LN
;
BLDHDR(DSPMODE) ; build display header
;
; DSPMODE = 0 for displaying approved requests, DSPMODE = 1 for displaying denied requests
;
N HASPND,PNDSTR
S PNDSTR=$$GETPEND^DGOTHUT1(DGDFN),HASPND=+PNDSTR
S VALMHDR(1)=$$LJ^XLFSTR("Current view: "_$S(DSPMODE:"Denied",1:"Approved")_" requests",40)
S VALMHDR(1)=VALMHDR(1)_$$LJ^XLFSTR("Pending request: "_$S(HASPND=1:"Yes",1:"No"),40)
S VALMHDR(2)=$$LJ^XLFSTR("Patient: "_$S(DGDFN>0:$$EXTERNAL^DILFD(33,.01,,DGDFN),1:"Not selected"),40)
;S VALMHDR(2)=VALMHDR(2)_$$LJ^XLFSTR("Pending request date: "_$S(HASPND=1:$$FMTE^XLFDT($P(PNDSTR,U,2),"2DZ"),1:"N/A"),40)
S VALMHDR(2)=VALMHDR(2)_$$LJ^XLFSTR("Date request submitted: "_$S(HASPND=1:$$FMTE^XLFDT($P(PNDSTR,U,2),"2DZ"),1:"N/A"),40)
S VALMHDR(3)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHMGT 5101 printed Nov 22, 2024@17:56:55 Page 2
DGOTHMGT ;SHRPE/YMG - OTH Management option ;04/30/19
+1 ;;5.3;Registration;**952**;Aug 13, 1993;Build 160
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 NEW DGDFN,DGIEN33,DGSVDDF,DSPMODE,HASREQ
+2 ; 0 = display approved requests, 1 = display denied requests
SET DSPMODE=0
+3 SET (DGDFN,DGIEN33)=0
+4 ; load list template
+5 DO EN^VALM("DG OTH MANAGEMENT")
+6 QUIT
+7 ;
HDR ; header code
+1 DO BLDHDR(DSPMODE)
+2 QUIT
+3 ;
INIT ; init variables and list array
+1 SET VALMBG=1
+2 ; save off VALMDDF array data for approved and denied requests
+3 MERGE DGSVDDF("A")=VALMDDF
+4 SET DGSVDDF("D","LINE")="LINE^2^4^Line^U^0"
+5 SET DGSVDDF("D","SUBMISSION DATE")="SUBMISSION DATE^8^15^Submission date^U^0"
+6 SET DGSVDDF("D","COMMENT")="COMMENT^25^55^Authorization comment^U^0"
+7 ; build list to display
+8 DO SET^VALM10(1,"")
+9 DO SET^VALM10(2,$$CJ^XLFSTR("A patient has not been selected. Please select a patient.",80))
+10 SET VALMCNT=2
+11 QUIT
+12 ;
HELP ; help code
+1 DO FULL^VALM1
+2 WRITE @IOF
+3 WRITE !,"This option allows users to view and enter / edit OTH data."
+4 WRITE !
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
EXIT ; exit point
+1 ;
+2 DO CLEAN^VALM10
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
BLD(DSPMODE) ; build list of requests for display
+1 ;
+2 ; DSPMODE = 0 for displaying approved requests, DSPMODE = 1 for displaying denied requests
+3 ;
+4 NEW DENIEN,DGIEN365,DGIEN90,Z
+5 DO CLEAN^VALM10
SET VALMCNT=0
+6 ; set to 1 if there's at least one request on the list
SET HASREQ=0
+7 WRITE !!,"Working..."
+8 IF DGIEN33'>0
GOTO BLDX
+9 IF DSPMODE
Begin DoDot:1
+10 ; build list of denied requests
+11 SET Z=0
FOR
SET Z=$ORDER(^DGOTH(33,DGIEN33,3,"C",Z))
if 'Z
QUIT
Begin DoDot:2
+12 SET DENIEN=+$ORDER(^DGOTH(33,DGIEN33,3,"C",Z,""))
IF 'DENIEN
QUIT
+13 SET VALMCNT=$$BLDLND(VALMCNT,DENIEN)
IF '(VALMCNT#10)
WRITE "."
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
GOTO BLDX
+16 ; DSPMODE=0, build list of approved requests
+17 SET DGIEN365=0
FOR
SET DGIEN365=$ORDER(^DGOTH(33,DGIEN33,1,DGIEN365))
if 'DGIEN365
QUIT
Begin DoDot:1
+18 SET DGIEN90=0
FOR
SET DGIEN90=$ORDER(^DGOTH(33,DGIEN33,1,DGIEN365,1,DGIEN90))
if 'DGIEN90
QUIT
Begin DoDot:2
+19 SET VALMCNT=$$BLDLNA(VALMCNT,DGIEN365,DGIEN90)
IF '(VALMCNT#10)
WRITE "."
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 ;
BLDX ; exit point
+1 IF VALMCNT=0
SET VALMCNT=$$NOREC(DSPMODE)
QUIT
+2 SET HASREQ=1
+3 QUIT
+4 ;
NOREC(DSPMODE) ; show message when display list is empty
+1 ;
+2 ; DSPMODE = 0 for displaying approved requests, DSPMODE = 1 for displaying denied requests
+3 ;
+4 ; returns line count in the created array
+5 ;
+6 DO SET^VALM10(1,"")
+7 DO SET^VALM10(2,"")
+8 DO SET^VALM10(3,$$SETSTR^VALM1("No "_$SELECT(DSPMODE:"denied",1:"approved")_" requests found.","",26,29))
+9 QUIT 3
+10 ;
BLDLND(LNUM,DENIEN) ; build one denied request line to display
+1 ;
+2 ; LNUM - last line number
+3 ; DENIEN - ien in sub-file 33.03
+4 ;
+5 ; returns current line number
+6 ;
+7 NEW DATASTR,LINE,LN
+8 SET DATASTR=$$GETDEN^DGOTHUT1(DGIEN33,DENIEN)
+9 ; build line
+10 SET LINE=""
SET LN=LNUM+1
+11 SET LINE=$$SETSTR^VALM1($$CJ^XLFSTR(LN,$PIECE(VALMDDF("LINE"),U,3)),LINE,1,3)
+12 SET LINE=$$SETFLD^VALM1($$CJ^XLFSTR($$FMTE^XLFDT($PIECE(DATASTR,U,2),"2DZ"),$PIECE(VALMDDF("SUBMISSION DATE"),U,3)),LINE,"SUBMISSION DATE")
+13 SET LINE=$$SETFLD^VALM1($EXTRACT($PIECE(DATASTR,U,3),1,55),LINE,"COMMENT")
+14 DO SET^VALM10(LN,LINE,LN)
+15 SET @VALMAR@("IDX",LN,LN)=DENIEN
+16 QUIT LN
+17 ;
BLDLNA(LNUM,DGIEN365,DGIEN90) ; build one approved request line to display
+1 ;
+2 ; LNUM - last line number
+3 ; DGIEN365 - ien in sub-file 33.01
+4 ; DGIEN90 - ien in sub-file 33.11
+5 ;
+6 ; returns current line number
+7 ;
+8 NEW AUTH,DATASTR,DGNOW,ENDDT,LINE,LN,NUM90,STARTDT,STATUS
+9 SET DATASTR=$$GET90DT^DGOTHUT1(DGIEN33,DGIEN365,DGIEN90)
+10 SET ENDDT=$PIECE(DATASTR,U,2)
+11 SET DATASTR=$$GETAUTH^DGOTHUT1(DGIEN33,DGIEN365,DGIEN90)
+12 SET STARTDT=$PIECE(DATASTR,U,3)
SET NUM90=$PIECE(DATASTR,U,2)
+13 ; build line
+14 SET LINE=""
SET LN=LNUM+1
+15 SET LINE=$$SETSTR^VALM1($$CJ^XLFSTR(LN,$PIECE(VALMDDF("LINE"),U,3)),LINE,1,3)
+16 SET LINE=$$SETFLD^VALM1($$CJ^XLFSTR($PIECE(DATASTR,U),$PIECE(VALMDDF("365 DAY NUM"),U,3)),LINE,"365 DAY NUM")
+17 SET LINE=$$SETFLD^VALM1($$CJ^XLFSTR(NUM90,$PIECE(VALMDDF("90 DAY NUM"),U,3)),LINE,"90 DAY NUM")
+18 SET LINE=$$SETFLD^VALM1($$FMTE^XLFDT(STARTDT,"2DZ"),LINE,"START DATE")
+19 SET LINE=$$SETFLD^VALM1($$FMTE^XLFDT(ENDDT,"2DZ"),LINE,"END DATE")
+20 SET AUTH=$SELECT(NUM90'>1:"Not required",1:$$FMTE^XLFDT($PIECE(DATASTR,U,5),"2DZ"))
+21 SET LINE=$$SETFLD^VALM1(AUTH,LINE,"AUTH")
+22 SET DGNOW=$$NOW^XLFDT()
+23 SET STATUS=$SELECT(STARTDT>DGNOW:"Not started",ENDDT<DGNOW:"Expired",1:"Active")
+24 SET LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
+25 DO SET^VALM10(LN,LINE,LN)
+26 SET @VALMAR@("IDX",LN,LN)=DGIEN365_U_DGIEN90
+27 QUIT LN
+28 ;
BLDHDR(DSPMODE) ; build display header
+1 ;
+2 ; DSPMODE = 0 for displaying approved requests, DSPMODE = 1 for displaying denied requests
+3 ;
+4 NEW HASPND,PNDSTR
+5 SET PNDSTR=$$GETPEND^DGOTHUT1(DGDFN)
SET HASPND=+PNDSTR
+6 SET VALMHDR(1)=$$LJ^XLFSTR("Current view: "_$SELECT(DSPMODE:"Denied",1:"Approved")_" requests",40)
+7 SET VALMHDR(1)=VALMHDR(1)_$$LJ^XLFSTR("Pending request: "_$SELECT(HASPND=1:"Yes",1:"No"),40)
+8 SET VALMHDR(2)=$$LJ^XLFSTR("Patient: "_$SELECT(DGDFN>0:$$EXTERNAL^DILFD(33,.01,,DGDFN),1:"Not selected"),40)
+9 ;S VALMHDR(2)=VALMHDR(2)_$$LJ^XLFSTR("Pending request date: "_$S(HASPND=1:$$FMTE^XLFDT($P(PNDSTR,U,2),"2DZ"),1:"N/A"),40)
+10 SET VALMHDR(2)=VALMHDR(2)_$$LJ^XLFSTR("Date request submitted: "_$SELECT(HASPND=1:$$FMTE^XLFDT($PIECE(PNDSTR,U,2),"2DZ"),1:"N/A"),40)
+11 SET VALMHDR(3)=""
+12 QUIT
