- DVBHUTIL ;ALB/JLU -This is a general utility program ;3/19/90
- ;;4.0;HINQ;**3,12,17,32**;03/25/92
- ;entry point for DVBHQUP to set up intensity for screens.
- A S DVBOUT="",IOP="HOME",(DVBBLO,DVBBLF,DVBON,DVBOFF,DVBLIT1,DVBLIT2)="" D ^%ZIS K IOP
- I $S('$D(^DVB(395,1,0)):1,'$P(^(0),U,3):1,1:0) Q
- S X="IOINHI;IOINLOW;IOBON;IOBOFF" D ENDR^%ZISS S DVBON=IOINHI,DVBOFF=IOINLOW,DVBBLO=IOBON,DVBBLF=IOBOFF
- ;;;I ^%ZOSF("OS")["VAX" S DVBLIT="" E ;
- W !,DVBON,"",DVBOFF S O=$X
- S DVBLIT1="S DX=$X-"_O_",DY=$S($Y>IOSL:IOSL,1:$Y) "_^%ZOSF("XY")_" K DX,DY"
- W !,DVBBLO,"",DVBBLF S O=$X
- S DVBLIT2="S DX=$X-"_O_",DY=$S($Y>IOSL:IOSL,1:$Y) "_^%ZOSF("XY")_" K DX,DY"
- ;
- ;
- K IOINHI,IOINLOW,IOBOFF,IOBON
- Q
- ;Entry point from update template for three part question
- Q W !!,"Is this the patient to update (YES, NO, IGNORE, DISPLAY, ALERT)? YES//" R DVBUQ:DTIME S DVBOUT=DVBUQ
- I DVBUQ["^" S Y="@10" Q
- I "Yy"[DVBUQ!(""[DVBUQ) S $P(^DVB(395.5,DFN,0),U,5)="I" W " YES" DO Q
- .I '$D(DVBDATA) Q
- .I 'DVBDATA Q
- .S DIE("NO^")=""
- .S Y=+DVBDATA
- .S Y=$S("1234"[Y:"@"_(Y-1),Y=5:"@104",Y=6:"@1006",1:"@10")
- .Q:Y="@10"
- .S DVBDATA=$P(DVBDATA,"^",2,10)_"^"_$P(DVBDATA,"^",10,99)
- .I Y="@" S Y="@8"
- I "Nn"[DVBUQ S Y="@10" W " NO" Q
- I "Ii"[DVBUQ S Y="@10" S $P(^DVB(395.5,DFN,0),U,5)="I" W " IGNORE" Q
- ;
- I "Dd"[DVBUQ W " DISPLAY" S DVBMM=1,DVBJIO=IO(0) D EN^DVBHIQM,WRT1^DVBHQD1,TEM^DVBHIQR K ^TMP($J),DVBMM,DVBJIO S Y="@101" Q
- I "Aa"[DVBUQ,$D(DVBDATA),1 W " ALERT" DO Q
- .D ACHK^DVBHT1
- .D DISPLAY^DVBHT I $D(DVBNOALR) S Y="@10" Q
- .I $D(DVBJ2),DVBJ2 D ACKNOW^DVBHT S Y="@101" Q
- .D PAGE^DVBHT S Y="@101" Q
- E I "Aa"[DVBUQ DO G Q
- .W !!,"You are not processing an Alert, 'A'lert update and display not available."
- ;
- W *7,!," 'Y'es, Will continue with this patient",!," 'N'o, Go next patient",!," 'I'gnore, Patient will NOT appear in ALL option until reHINQ",!," 'D'isplay will show you the HINQ mail message."
- W !," 'A'lert, will update and display the Alert if processing alerts",!," '^' to quit"
- G Q
- ;header for ^DVBHQZ6
- 2 W !,?9,"**************************************************************"
- W !,?9,"* This option will print out a report, identical to the mail *"
- W !,?9,"* messages, of the patients in the suspense file with a *"
- W !,?9,"* successful HINQ request. *"
- W !,?9,"**************************************************************"
- Q
- ;
- SIGN ;General sign converter var to be worked on/defined DVBV1,DVBV2
- ;DVBV1 contains the string of characters
- ;DVBV2 contains the character at which the sign resides.
- ;Must be sure there is a sign there before sending to this routine
- N CT,A1,V
- I '$D(DVBS) S CT=1,DVBS("{")=0 F A1=65:1:73 S DVBS($C(A1))=CT S CT=CT+1
- I '$D(DVBS($E(DVBV1,DVBV2))) D W2 Q
- S V=DVBS($E(DVBV1,DVBV2)),DVBV2=$S(DVBV2=1:1,1:DVBV2-1),DVBV1=$S(DVBV2=1:"",1:$E(DVBV1,1,DVBV2))_V
- Q
- ;
- SCRHD W @$S('$D(IOF):"#",IOF="":"#",1:IOF)
- W ?1,$E(DVBDIQ(2,DFN,.01,"E"),1,30)
- W ?22,"Patient File"
- W ?35,DVBON,"((",DVBSCRN,"))",DVBOFF X DVBLIT1
- W ?49,"HINQ Response"
- W ?68,"SSN: ",DVBON,$E(DVBDIQ(2,DFN,.09,"E"),6,9),DVBOFF
- W !,"-------------------------------------------------------------------------------"
- Q
- ;
- CHK ;This entry point will print an error message for the edit template
- ;if the diag. were BIRLS only and the DIAG. Verif. ind. was not 'Y'
- ;
- W !!,*7,?7,"BIRLS only response and the 'Diagnostic Verified Indicator' is NO.",!,?16,"Verify SC at folder location: ",DVBFL,!,?28,DVBON,"No updating allowed.",DVBOFF
- X DVBLIT1 S DVB=D0,DVBLP=2,DVBMM=1 D QB^DVBHQZ6 S Y="@50"
- Q
- ;
- POW ;This entry point is to determine the variable for the input to the
- ;patient file. Whether POW or not.
- ;
- I $D(DVBPOW) S DVBPOW1=$S(DVBPOW=1!(DVBPOW=2):"Y",1:"N")
- I $D(DVBPOWD) S DVBPOW1=$S(+DVBPOWD:"Y",1:"N")
- Q
- ;
- VERR ;This entry point prints an error message if mas not >5.1 cause .305 unemployable field is not there.
- W !!,*7,?2,"Your version of MAS is NOT greater than 5.1, thus the Unemployable field"
- W !,?2,"is not in your patient file. No uploading of this field allowed."
- R !,?25,"<RET to continue>",DVBQ:DTIME K DVBQ
- Q
- ;
- SCRQ ;The screens will call this entry point to read the answer from the user.
- W !!,DVBON,"<RET> ",DVBOFF X DVBLIT1
- W "to CONTINUE, "
- W DVBON,"'^' ",DVBOFF X DVBLIT1
- W "to QUIT, "
- W DVBON,"N N-N N,N,N,N or (A)-ALL",DVBOFF X DVBLIT1
- W " to update: "
- R ANS:DTIME S Y=$S(ANS="^"!($T=0):"@10",ANS=""&$T=1:"@4",ANS["?":"@6",1:"@8")
- I Y="@4",$D(DVBDATA),DVBDATA DO
- .S Y=+DVBDATA
- .S DVBDATA=$P(DVBDATA,"^",2,10)_"^"_$P(DVBDATA,"^",10,99)
- .S Y=$S("1234"[Y:"@"_(Y-1),Y=5:"@104",Y=6:"@1006",1:"@10")
- I Y="@8" ;;;,$D(DVBDATA),DVBDATA S $P(DVBDATA,"^")=""
- Q
- S Y=$S(DVBJS=11:"@1",DVBJS=28:"@2",DVBJS=35:"@3",DVBJS=44:"@104",DVBJS=53:"@1006",1:"@10")
- Q
- ;
- W2 ;error message for missing data found in sign subroutine
- S DVBERCS=1 I '$G(DVBTSK) D
- .W !!!!,?15,"HINQ data does NOT seem right."
- .I +DFN>0 D
- ..W !,?15,"Data appears to be missing for ",$S($D(^DPT(DFN,0)):$P(^(0),U),1:DFN)
- ..W !,?15,"Please re-HINQ for this patient.",! H 3
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHUTIL 5160 printed Feb 18, 2025@23:25:35 Page 2
- DVBHUTIL ;ALB/JLU -This is a general utility program ;3/19/90
- +1 ;;4.0;HINQ;**3,12,17,32**;03/25/92
- +2 ;entry point for DVBHQUP to set up intensity for screens.
- A SET DVBOUT=""
- SET IOP="HOME"
- SET (DVBBLO,DVBBLF,DVBON,DVBOFF,DVBLIT1,DVBLIT2)=""
- DO ^%ZIS
- KILL IOP
- +1 IF $SELECT('$DATA(^DVB(395,1,0)):1,'$PIECE(^(0),U,3):1,1:0)
- QUIT
- +2 SET X="IOINHI;IOINLOW;IOBON;IOBOFF"
- DO ENDR^%ZISS
- SET DVBON=IOINHI
- SET DVBOFF=IOINLOW
- SET DVBBLO=IOBON
- SET DVBBLF=IOBOFF
- +3 ;;;I ^%ZOSF("OS")["VAX" S DVBLIT="" E ;
- +4 WRITE !,DVBON,"",DVBOFF
- SET O=$X
- +5 SET DVBLIT1="S DX=$X-"_O_",DY=$S($Y>IOSL:IOSL,1:$Y) "_^%ZOSF("XY")_" K DX,DY"
- +6 WRITE !,DVBBLO,"",DVBBLF
- SET O=$X
- +7 SET DVBLIT2="S DX=$X-"_O_",DY=$S($Y>IOSL:IOSL,1:$Y) "_^%ZOSF("XY")_" K DX,DY"
- +8 ;
- +9 ;
- +10 KILL IOINHI,IOINLOW,IOBOFF,IOBON
- +11 QUIT
- +12 ;Entry point from update template for three part question
- Q WRITE !!,"Is this the patient to update (YES, NO, IGNORE, DISPLAY, ALERT)? YES//"
- READ DVBUQ:DTIME
- SET DVBOUT=DVBUQ
- +1 IF DVBUQ["^"
- SET Y="@10"
- QUIT
- +2 IF "Yy"[DVBUQ!(""[DVBUQ)
- SET $PIECE(^DVB(395.5,DFN,0),U,5)="I"
- WRITE " YES"
- Begin DoDot:1
- +3 IF '$DATA(DVBDATA)
- QUIT
- +4 IF 'DVBDATA
- QUIT
- +5 SET DIE("NO^")=""
- +6 SET Y=+DVBDATA
- +7 SET Y=$SELECT("1234"[Y:"@"_(Y-1),Y=5:"@104",Y=6:"@1006",1:"@10")
- +8 if Y="@10"
- QUIT
- +9 SET DVBDATA=$PIECE(DVBDATA,"^",2,10)_"^"_$PIECE(DVBDATA,"^",10,99)
- +10 IF Y="@"
- SET Y="@8"
- End DoDot:1
- QUIT
- +11 IF "Nn"[DVBUQ
- SET Y="@10"
- WRITE " NO"
- QUIT
- +12 IF "Ii"[DVBUQ
- SET Y="@10"
- SET $PIECE(^DVB(395.5,DFN,0),U,5)="I"
- WRITE " IGNORE"
- QUIT
- +13 ;
- +14 IF "Dd"[DVBUQ
- WRITE " DISPLAY"
- SET DVBMM=1
- SET DVBJIO=IO(0)
- DO EN^DVBHIQM
- DO WRT1^DVBHQD1
- DO TEM^DVBHIQR
- KILL ^TMP($JOB),DVBMM,DVBJIO
- SET Y="@101"
- QUIT
- +15 IF "Aa"[DVBUQ
- IF $DATA(DVBDATA)
- IF 1
- WRITE " ALERT"
- Begin DoDot:1
- +16 DO ACHK^DVBHT1
- +17 DO DISPLAY^DVBHT
- IF $DATA(DVBNOALR)
- SET Y="@10"
- QUIT
- +18 IF $DATA(DVBJ2)
- IF DVBJ2
- DO ACKNOW^DVBHT
- SET Y="@101"
- QUIT
- +19 DO PAGE^DVBHT
- SET Y="@101"
- QUIT
- End DoDot:1
- QUIT
- +20 IF '$TEST
- IF "Aa"[DVBUQ
- Begin DoDot:1
- +21 WRITE !!,"You are not processing an Alert, 'A'lert update and display not available."
- End DoDot:1
- GOTO Q
- +22 ;
- +23 WRITE *7,!," 'Y'es, Will continue with this patient",!," 'N'o, Go next patient",!," 'I'gnore, Patient will NOT appear in ALL option until reHINQ",!," 'D'isplay will show you the HINQ mail message."
- +24 WRITE !," 'A'lert, will update and display the Alert if processing alerts",!," '^' to quit"
- +25 GOTO Q
- +26 ;header for ^DVBHQZ6
- 2 WRITE !,?9,"**************************************************************"
- +1 WRITE !,?9,"* This option will print out a report, identical to the mail *"
- +2 WRITE !,?9,"* messages, of the patients in the suspense file with a *"
- +3 WRITE !,?9,"* successful HINQ request. *"
- +4 WRITE !,?9,"**************************************************************"
- +5 QUIT
- +6 ;
- SIGN ;General sign converter var to be worked on/defined DVBV1,DVBV2
- +1 ;DVBV1 contains the string of characters
- +2 ;DVBV2 contains the character at which the sign resides.
- +3 ;Must be sure there is a sign there before sending to this routine
- +4 NEW CT,A1,V
- +5 IF '$DATA(DVBS)
- SET CT=1
- SET DVBS("{")=0
- FOR A1=65:1:73
- SET DVBS($CHAR(A1))=CT
- SET CT=CT+1
- +6 IF '$DATA(DVBS($EXTRACT(DVBV1,DVBV2)))
- DO W2
- QUIT
- +7 SET V=DVBS($EXTRACT(DVBV1,DVBV2))
- SET DVBV2=$SELECT(DVBV2=1:1,1:DVBV2-1)
- SET DVBV1=$SELECT(DVBV2=1:"",1:$EXTRACT(DVBV1,1,DVBV2))_V
- +8 QUIT
- +9 ;
- SCRHD WRITE @$SELECT('$DATA(IOF):"#",IOF="":"#",1:IOF)
- +1 WRITE ?1,$EXTRACT(DVBDIQ(2,DFN,.01,"E"),1,30)
- +2 WRITE ?22,"Patient File"
- +3 WRITE ?35,DVBON,"((",DVBSCRN,"))",DVBOFF
- XECUTE DVBLIT1
- +4 WRITE ?49,"HINQ Response"
- +5 WRITE ?68,"SSN: ",DVBON,$EXTRACT(DVBDIQ(2,DFN,.09,"E"),6,9),DVBOFF
- +6 WRITE !,"-------------------------------------------------------------------------------"
- +7 QUIT
- +8 ;
- CHK ;This entry point will print an error message for the edit template
- +1 ;if the diag. were BIRLS only and the DIAG. Verif. ind. was not 'Y'
- +2 ;
- +3 WRITE !!,*7,?7,"BIRLS only response and the 'Diagnostic Verified Indicator' is NO.",!,?16,"Verify SC at folder location: ",DVBFL,!,?28,DVBON,"No updating allowed.",DVBOFF
- +4 XECUTE DVBLIT1
- SET DVB=D0
- SET DVBLP=2
- SET DVBMM=1
- DO QB^DVBHQZ6
- SET Y="@50"
- +5 QUIT
- +6 ;
- POW ;This entry point is to determine the variable for the input to the
- +1 ;patient file. Whether POW or not.
- +2 ;
- +3 IF $DATA(DVBPOW)
- SET DVBPOW1=$SELECT(DVBPOW=1!(DVBPOW=2):"Y",1:"N")
- +4 IF $DATA(DVBPOWD)
- SET DVBPOW1=$SELECT(+DVBPOWD:"Y",1:"N")
- +5 QUIT
- +6 ;
- VERR ;This entry point prints an error message if mas not >5.1 cause .305 unemployable field is not there.
- +1 WRITE !!,*7,?2,"Your version of MAS is NOT greater than 5.1, thus the Unemployable field"
- +2 WRITE !,?2,"is not in your patient file. No uploading of this field allowed."
- +3 READ !,?25,"<RET to continue>",DVBQ:DTIME
- KILL DVBQ
- +4 QUIT
- +5 ;
- SCRQ ;The screens will call this entry point to read the answer from the user.
- +1 WRITE !!,DVBON,"<RET> ",DVBOFF
- XECUTE DVBLIT1
- +2 WRITE "to CONTINUE, "
- +3 WRITE DVBON,"'^' ",DVBOFF
- XECUTE DVBLIT1
- +4 WRITE "to QUIT, "
- +5 WRITE DVBON,"N N-N N,N,N,N or (A)-ALL",DVBOFF
- XECUTE DVBLIT1
- +6 WRITE " to update: "
- +7 READ ANS:DTIME
- SET Y=$SELECT(ANS="^"!($TEST=0):"@10",ANS=""&$TEST=1:"@4",ANS["?":"@6",1:"@8")
- +8 IF Y="@4"
- IF $DATA(DVBDATA)
- IF DVBDATA
- Begin DoDot:1
- +9 SET Y=+DVBDATA
- +10 SET DVBDATA=$PIECE(DVBDATA,"^",2,10)_"^"_$PIECE(DVBDATA,"^",10,99)
- +11 SET Y=$SELECT("1234"[Y:"@"_(Y-1),Y=5:"@104",Y=6:"@1006",1:"@10")
- End DoDot:1
- +12 ;;;,$D(DVBDATA),DVBDATA S $P(DVBDATA,"^")=""
- IF Y="@8"
- +13 QUIT
- +14 SET Y=$SELECT(DVBJS=11:"@1",DVBJS=28:"@2",DVBJS=35:"@3",DVBJS=44:"@104",DVBJS=53:"@1006",1:"@10")
- +15 QUIT
- +16 ;
- W2 ;error message for missing data found in sign subroutine
- +1 SET DVBERCS=1
- IF '$GET(DVBTSK)
- Begin DoDot:1
- +2 WRITE !!!!,?15,"HINQ data does NOT seem right."
- +3 IF +DFN>0
- Begin DoDot:2
- +4 WRITE !,?15,"Data appears to be missing for ",$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),U),1:DFN)
- +5 WRITE !,?15,"Please re-HINQ for this patient.",!
- HANG 3
- End DoDot:2
- End DoDot:1
- +6 QUIT