SDESOPENVETREQS ;ALB/JAS,ANU - REPORT OF ALL OPEN VETERAN REQUESTS ; JUL 15, 2023
;;5.3;SCHEDULING;**843,851**;AUG 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
REQSBYVETS ;
N POP,REQIENS,REQUESTIEN,SRTOPT
K ^TMP("SDESOPENVETREQS",$J),REQIENS
;
S REQUESTIEN=0
F S REQUESTIEN=$O(^SDEC(409.85,"TYPE","VETERAN",REQUESTIEN)) Q:'REQUESTIEN D
. I $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C" Q
. S REQIENS(REQUESTIEN)=""
;
; Sort records per user selection
;
S SRTOPT=$$SRTOPT()
D SRTRECS(.REQIENS,SRTOPT)
;
; Open report device and print report details
;
D DEVOPEN,HEADER,DETAIL
;
; Close device and Clean locals vars before exit
;
D DEVCLOSE,EXIT
;
Q
;
SRTOPT() ;
; 1 - Date Entered (Default)
; 2 - Patient Name
;
N DTOUT,DUOUT,Y
W !!!,?21,"ALL OPEN VETERAN REQUESTS REPORT OPTIONS",!!
K DIR
S DIR(0)="SO^1:Date Entered;2:Patient Name"
S DIR("A")="Sort option"
S DIR("?")="Enter a number: 1 or 2"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
Q $S(Y>0:Y,1:1)
;
SRTRECS(REQIENS,SRTOPT) ;
N COMMLN,DFN,ENTERDT,INSTIT,LAST4,PNAME,SDREQDATA,SRTVAL1,SRTVAL2,SRVSPC,VA
S REQUESTIEN=0
F S REQUESTIEN=$O(REQIENS(REQUESTIEN)) Q:REQUESTIEN="" D
. D GETS^DIQ(409.85,REQUESTIEN_",","**","IE","SDREQDATA","SDERR")
. ;
. ; Detail Line 1
. ;
. S PNAME=$G(SDREQDATA(409.85,REQUESTIEN_",",.01,"E"))
. S DFN=$G(SDREQDATA(409.85,REQUESTIEN_",",.01,"I")) D DEM^VADPT
. S ENTERDT=$G(SDREQDATA(409.85,REQUESTIEN_",",9.5,"I"))
. I SRTOPT=1 S SRTVAL1=ENTERDT,SRTVAL2=PNAME
. I SRTOPT'=1 S SRTVAL1=PNAME,SRTVAL2=ENTERDT
. S ^TMP("SDESOPENVETREQS",$J,SRTVAL1,SRTVAL2,REQUESTIEN,1)=PNAME_"^"_VA("BID")
. ;
. ; Detail Line 2
. ;
. S INSTIT=$G(SDREQDATA(409.85,REQUESTIEN_",",2,"E"))
. S SRVSPC=$G(SDREQDATA(409.85,REQUESTIEN_",",8.5,"E"))
. S ^TMP("SDESOPENVETREQS",$J,SRTVAL1,SRTVAL2,REQUESTIEN,2)=INSTIT_"^"_SRVSPC
. ;
. ; Detail Line 3
. ;
. N LSTCON,PIDDT,SUBREQ
. S (LSTCON,PIDDT)=""
. I $D(SDREQDATA(409.8544)) D
. . S SUBREQ=$O(SDREQDATA(409.8544,""),-1),LSTCON=$G(SDREQDATA(409.8544,SUBREQ,3,"E"))
. I $D(SDREQDATA(409.854)) D
. . S SUBREQ=$O(SDREQDATA(409.854,""),-1),PIDDT=$G(SDREQDATA(409.854,SUBREQ,1,"E"))
. S ^TMP("SDESOPENVETREQS",$J,SRTVAL1,SRTVAL2,REQUESTIEN,3)=$P($$FMTE^XLFDT(ENTERDT),"@")_"^"_$$FMDIFF^XLFDT(DT,$P(ENTERDT,"@"))_"^"_PIDDT_"^"_LSTCON
. ;
. ; Patient Comments
. ;
. ;
. ; ANU
. ;I $D(SDREQDATA(409.85,REQUESTIEN_",",60)) D
. ;. S COMMLN=0
. ;. F S COMMLN=$O(SDREQDATA(409.85,REQUESTIEN_",",60,COMMLN)) Q:'COMMLN D
. ;. . S ^TMP("SDESOPENVETREQS",$J,SRTVAL1,SRTVAL2,REQUESTIEN,"COMM",COMMLN)=SDREQDATA(409.85,REQUESTIEN_",",60,COMMLN)
. K SDERR,SDREQDATA
Q
;
;
W !,"PATIENT NAME^LAST FOUR OF SSN^INSTITUTION^SERVICE/SPECIALTY"
W "^REQUEST ENTRY DATE^WAIT TIME^PID^LAST PATIENT CONTACT"
Q
;
DETAIL ; Detail line for Open Vet Request
N COMMLN,VRDATA1,VRDATA2,VRDATA3,VRSRT1,VRSRT2,VRIEN
S VRSRT1=""
F S VRSRT1=$O(^TMP("SDESOPENVETREQS",$J,VRSRT1)) Q:VRSRT1="" D
. S VRSRT2=""
. F S VRSRT2=$O(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2)) Q:VRSRT2="" D
. . S VRIEN=0
. . F S VRIEN=$O(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN)) Q:'VRIEN D
. . . S VRDATA1=$G(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,1))
. . . S VRDATA2=$G(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,2))
. . . S VRDATA3=$G(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,3))
. . . W !,VRDATA1_"^"_VRDATA2_"^"_VRDATA3_"^"
. . . ;ANU
. . . ;I $D(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,"COMM")) D
. . . ;. S COMMLN=0
. . . ;. F S COMMLN=$O(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,"COMM",COMMLN)) Q:'COMMLN D
. . . ;. . W ^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,"COMM",COMMLN)_" | "
Q
;
DEVOPEN ;Prompt for device
;
D ^%ZIS Q:POP
U IO
Q
;
DEVCLOSE ;Close device
;
D ^%ZISC
Q
;
EXIT ;Clean-up local vars and temp globals
;
K ^TMP("SDESOPENVETREQS",$J),REQIENS,VA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESOPENVETREQS 4060 printed Nov 22, 2024@18:07:16 Page 2
SDESOPENVETREQS ;ALB/JAS,ANU - REPORT OF ALL OPEN VETERAN REQUESTS ; JUL 15, 2023
+1 ;;5.3;SCHEDULING;**843,851**;AUG 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
REQSBYVETS ;
+1 NEW POP,REQIENS,REQUESTIEN,SRTOPT
+2 KILL ^TMP("SDESOPENVETREQS",$JOB),REQIENS
+3 ;
+4 SET REQUESTIEN=0
+5 FOR
SET REQUESTIEN=$ORDER(^SDEC(409.85,"TYPE","VETERAN",REQUESTIEN))
if 'REQUESTIEN
QUIT
Begin DoDot:1
+6 IF $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C"
QUIT
+7 SET REQIENS(REQUESTIEN)=""
End DoDot:1
+8 ;
+9 ; Sort records per user selection
+10 ;
+11 SET SRTOPT=$$SRTOPT()
+12 DO SRTRECS(.REQIENS,SRTOPT)
+13 ;
+14 ; Open report device and print report details
+15 ;
+16 DO DEVOPEN
DO HEADER
DO DETAIL
+17 ;
+18 ; Close device and Clean locals vars before exit
+19 ;
+20 DO DEVCLOSE
DO EXIT
+21 ;
+22 QUIT
+23 ;
SRTOPT() ;
+1 ; 1 - Date Entered (Default)
+2 ; 2 - Patient Name
+3 ;
+4 NEW DTOUT,DUOUT,Y
+5 WRITE !!!,?21,"ALL OPEN VETERAN REQUESTS REPORT OPTIONS",!!
+6 KILL DIR
+7 SET DIR(0)="SO^1:Date Entered;2:Patient Name"
+8 SET DIR("A")="Sort option"
+9 SET DIR("?")="Enter a number: 1 or 2"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+12 QUIT $SELECT(Y>0:Y,1:1)
+13 ;
SRTRECS(REQIENS,SRTOPT) ;
+1 NEW COMMLN,DFN,ENTERDT,INSTIT,LAST4,PNAME,SDREQDATA,SRTVAL1,SRTVAL2,SRVSPC,VA
+2 SET REQUESTIEN=0
+3 FOR
SET REQUESTIEN=$ORDER(REQIENS(REQUESTIEN))
if REQUESTIEN=""
QUIT
Begin DoDot:1
+4 DO GETS^DIQ(409.85,REQUESTIEN_",","**","IE","SDREQDATA","SDERR")
+5 ;
+6 ; Detail Line 1
+7 ;
+8 SET PNAME=$GET(SDREQDATA(409.85,REQUESTIEN_",",.01,"E"))
+9 SET DFN=$GET(SDREQDATA(409.85,REQUESTIEN_",",.01,"I"))
DO DEM^VADPT
+10 SET ENTERDT=$GET(SDREQDATA(409.85,REQUESTIEN_",",9.5,"I"))
+11 IF SRTOPT=1
SET SRTVAL1=ENTERDT
SET SRTVAL2=PNAME
+12 IF SRTOPT'=1
SET SRTVAL1=PNAME
SET SRTVAL2=ENTERDT
+13 SET ^TMP("SDESOPENVETREQS",$JOB,SRTVAL1,SRTVAL2,REQUESTIEN,1)=PNAME_"^"_VA("BID")
+14 ;
+15 ; Detail Line 2
+16 ;
+17 SET INSTIT=$GET(SDREQDATA(409.85,REQUESTIEN_",",2,"E"))
+18 SET SRVSPC=$GET(SDREQDATA(409.85,REQUESTIEN_",",8.5,"E"))
+19 SET ^TMP("SDESOPENVETREQS",$JOB,SRTVAL1,SRTVAL2,REQUESTIEN,2)=INSTIT_"^"_SRVSPC
+20 ;
+21 ; Detail Line 3
+22 ;
+23 NEW LSTCON,PIDDT,SUBREQ
+24 SET (LSTCON,PIDDT)=""
+25 IF $DATA(SDREQDATA(409.8544))
Begin DoDot:2
+26 SET SUBREQ=$ORDER(SDREQDATA(409.8544,""),-1)
SET LSTCON=$GET(SDREQDATA(409.8544,SUBREQ,3,"E"))
End DoDot:2
+27 IF $DATA(SDREQDATA(409.854))
Begin DoDot:2
+28 SET SUBREQ=$ORDER(SDREQDATA(409.854,""),-1)
SET PIDDT=$GET(SDREQDATA(409.854,SUBREQ,1,"E"))
End DoDot:2
+29 SET ^TMP("SDESOPENVETREQS",$JOB,SRTVAL1,SRTVAL2,REQUESTIEN,3)=$PIECE($$FMTE^XLFDT(ENTERDT),"@")_"^"_$$FMDIFF^XLFDT(DT,$PIECE(ENTERDT,"@"))_"^"_PIDDT_"^"_LSTCON
+30 ;
+31 ; Patient Comments
+32 ;
+33 ;
+34 ; ANU
+35 ;I $D(SDREQDATA(409.85,REQUESTIEN_",",60)) D
+36 ;. S COMMLN=0
+37 ;. F S COMMLN=$O(SDREQDATA(409.85,REQUESTIEN_",",60,COMMLN)) Q:'COMMLN D
+38 ;. . S ^TMP("SDESOPENVETREQS",$J,SRTVAL1,SRTVAL2,REQUESTIEN,"COMM",COMMLN)=SDREQDATA(409.85,REQUESTIEN_",",60,COMMLN)
+39 KILL SDERR,SDREQDATA
End DoDot:1
+40 QUIT
+41 ;
+1 ;
+2 WRITE !,"PATIENT NAME^LAST FOUR OF SSN^INSTITUTION^SERVICE/SPECIALTY"
+3 WRITE "^REQUEST ENTRY DATE^WAIT TIME^PID^LAST PATIENT CONTACT"
+4 QUIT
+5 ;
DETAIL ; Detail line for Open Vet Request
+1 NEW COMMLN,VRDATA1,VRDATA2,VRDATA3,VRSRT1,VRSRT2,VRIEN
+2 SET VRSRT1=""
+3 FOR
SET VRSRT1=$ORDER(^TMP("SDESOPENVETREQS",$JOB,VRSRT1))
if VRSRT1=""
QUIT
Begin DoDot:1
+4 SET VRSRT2=""
+5 FOR
SET VRSRT2=$ORDER(^TMP("SDESOPENVETREQS",$JOB,VRSRT1,VRSRT2))
if VRSRT2=""
QUIT
Begin DoDot:2
+6 SET VRIEN=0
+7 FOR
SET VRIEN=$ORDER(^TMP("SDESOPENVETREQS",$JOB,VRSRT1,VRSRT2,VRIEN))
if 'VRIEN
QUIT
Begin DoDot:3
+8 SET VRDATA1=$GET(^TMP("SDESOPENVETREQS",$JOB,VRSRT1,VRSRT2,VRIEN,1))
+9 SET VRDATA2=$GET(^TMP("SDESOPENVETREQS",$JOB,VRSRT1,VRSRT2,VRIEN,2))
+10 SET VRDATA3=$GET(^TMP("SDESOPENVETREQS",$JOB,VRSRT1,VRSRT2,VRIEN,3))
+11 WRITE !,VRDATA1_"^"_VRDATA2_"^"_VRDATA3_"^"
+12 ;ANU
+13 ;I $D(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,"COMM")) D
+14 ;. S COMMLN=0
+15 ;. F S COMMLN=$O(^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,"COMM",COMMLN)) Q:'COMMLN D
+16 ;. . W ^TMP("SDESOPENVETREQS",$J,VRSRT1,VRSRT2,VRIEN,"COMM",COMMLN)_" | "
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
DEVOPEN ;Prompt for device
+1 ;
+2 DO ^%ZIS
if POP
QUIT
+3 USE IO
+4 QUIT
+5 ;
DEVCLOSE ;Close device
+1 ;
+2 DO ^%ZISC
+3 QUIT
+4 ;
EXIT ;Clean-up local vars and temp globals
+1 ;
+2 KILL ^TMP("SDESOPENVETREQS",$JOB),REQIENS,VA
+3 QUIT
