DVBHT ;PKE/ISC-ALBANY; HINQ alert parser; 5/10/92 ; 3/9/06 4:18pm
;;4.0;HINQ;**12,18,20,56**;03/25/92
;
;call alert
ALERT I '$D(ZTQUEUED) H 1 W $C(7),".. Alert found."
S (I,Y)=0,XQAMSG=""
F S Y=$O(DVBDATA(Y)) Q:'Y DO
.S $P(DVBDATA,"^",I+1)=Y
.S XQAMSG=XQAMSG_$S(I:", ",1:"")_Y S I=I+1
.K DVBDATA(Y)
S XQAMSG="Screen"_$S(I>1:"s ",1:" ")_XQAMSG
;
D MAILGP^DVBHT2,REQUSR^DVBHT2
I $D(XQA)'>9 S XQA(DUZ)=""
S Y=DT D TM
;
S XQAMSG=$E($P(^DPT(DFN,0),"^")_" ",1,9)_" "_"("_$E(^(0))_$E($P(^(0),"^",9),6,10)_")"_$S('$L($E($P(^(0),"^",9),10)):":",1:"")_" HINQ Update . "_$E(XQAMSG_" ",1,16)_$J(Y,8)
I '$O(XQA(0))
E S XQAMSG=XQAMSG_" "_$E($P($P(^VA(200,$O(XQA(0)),0),"^"),","),1,10)
;
TST S XQAID="DVB,"_DFN
S XQAROU="SETUP^DVBHT"
;S XQAFLG="R"
S XQADATA=DFN_"^"_DVBDATA K DVBDATA
;
D SETUP^XQALERT
S $P(^DVB(395.5,DFN,0),"^",6)=1 Q ;set alert SET
;
;entry action from alert
SETUP S DVBDATA=XQADATA K XQADATA,XQAKILL,DVBNOALR
S Y=+$P(DVBDATA,"^") Q:'Y
S DFN=Y,DVBDATA=$P(DVBDATA,"^",2,99)
I '$D(^DVB(395.5,Y,0)) S XQAKILL=0 D KIL Q
I '$P(^DVB(395.5,Y,0),"^",6) DO D KIL Q
.W !,?15," another request pending, alert cleared"
.S XQAKILL=0
I '$D(^XUSEC("DG ELIGIBILITY",DUZ)) DO D KIL Q
.S XQAKILL=1
.D DISPLAY
.D PAGE
;if no to hinq screens
I $P(^DVB(395,1,0),"^",5)="n" DO D END Q
.S XQAKILL=0,DVBJ2=1
.D TEM^DVBHIQR I $D(DVBERCS) K XQAKILL Q
.D ACHK^DVBHT1
.D DISPLAY
.I $D(DVBNOALR) D PAGE,FILE^DVBHQUP Q
.D ACKNOW
.I $D(DVBNOALR) D FILE^DVBHQUP Q
.K XQAKILL
;
D A^DVBHUTIL W !
K DVBDIQ
;
UPD L +^DPT(DFN):3 I $T DO
.N XQAID
.S DIE="^DPT(",(DA,DFN)=+Y,DR="[DVBHINQ UPDATE]",DVBJ2=0 D TEM^DVBHIQR
.N DVBQT
.I '$D(DVBERCS) D CHKID^DVBHQD1 I DVBQT D Q
.. N DVBTMP1,DVBTMP2
.. S DVBTMP1=$G(DVBNOALR)
.. S DVBTMP2=$G(DVBJ2)
.. S DVBNOALR=";4///a;5////"_DUZ_";6///N",DVBJ2=1
.. D FILE^DVBHQUP
.. S DVBNOALR=DVBTMP1
.. S DVBJ2=DVBTMP2
.D ^DIE:'$D(DVBERCS) K DIE,DR,DA Q
E W !?3,"This patient data is being edited by another user" H 1 G END
L -^DPT(DFN)
;
I DVBJ2 DO ;patient updated, alerts filed in up
.W !!,"Checking the alerts ."
.D ACHK^DVBHT1
.I $D(DVBNOALR) DO
. .S DVBNOALR=";4///c;5////"_DUZ_";6///N"
. .W ". OK"
.E DO
. .W ". need more changes"
. .D DISPLAY
. .D ACKNOW
.H 1
E DO ;patient not updated
.I $D(DVBNOALR) DO Q
. .I DVBNOALR]"" D FILE^DVBHQUP
. .;;;D DISPLAY
.D ACHK^DVBHT1
.D DISPLAY I $D(DVBNOALR) Q
.D ACKNOW
.I $D(DVBNOALR),DVBNOALR]"" D FILE^DVBHQUP
;
K DVBDIQ D C^DVBHQUP
;
END S END="N DVBNOALR,XQAID D KILL^XUSCLEAN" X END
I $D(DVBNOALR) S XQAKILL=0
KIL K DVBNOALR,DVBDATA,DFN,DVBJ2,DR,DVBDIQ,LP2,DIC,DIQ,DA,D0 Q
;
;display alert
DISPLAY Q:'$D(DVBDATA) I '$L($P(DVBDATA,"^",11)) DO CMSG Q
INFO ;
;;Diagnostic Ver.Ind.: NO Verify Service Connections at RO
I '$D(DVBDIQ(2,DFN,.01,"E")) S DR=".01;.09" D DIQDR^DVBHT1
S DVBALERT="LOAD/EDIT Screen"_$S(DVBDATA'["SC D":" 7",1:"s 7, 11")
W !," ----------------------------------------------------------------------------"
W !,"| ",DVBDIQ(2,DFN,.01,"E")," "
W $E(DVBDIQ(2,DFN,.01,"E")),$E(DVBDIQ(2,DFN,.09,"E"),6,10)
W ?39,DVBALERT,?69,"HINQ"
W ?77,"|",!
I $D(XQAKILL)
F I=11:1 S DVBALERT=$P(DVBDATA,"^",I)_"'" Q:'DVBALERT DO
.W:$X<10 "|",?6
.I $E(DVBALERT,2)="+" W "HINQ has data not in patient file `"
.I $E(DVBALERT,2)="-" W "Patient file has data not in HINQ `"
.I $E(DVBALERT,2)="?" W "HINQ, Patient file are different `"
.I $E(DVBALERT,2)="X" DO
. .I $E(DVBALERT,3) W $P($T(INFO+$E(DVBALERT,3)),";;",2)
. .S DVBALERT=$E(DVBALERT)
.W $E(DVBALERT,3,$L(DVBALERT))
.W ?66,"Screen (",$E(DVBALERT),")",?77,"|",!
W " ----------------------------------------------------------------------------"
K DVBALERT
Q
ACKNOW K DIR S DIR("A")="Do you wish to acknowledge inconsistencies and clear this Alert ? "
S DIR("B")="No"
S DIR("?",1)="If the patient file has data that should not be updated by HINQ, this Alert"
S DIR("?",2)="can be acknowledged and cleared by entering 'Y'es. Otherwise, just continue"
S DIR("?")="Press RETURN to continue,'Y'es to acknowledge, '^' to exit:"
S DIR(0)="YAO" D ^DIR K DIR Q:'Y
S DVBNOALR=";4///a;5////"_DUZ_";6///N"
W !!?6," Alert will be cleared" H 1 Q
;
PAGE K DVBALERT S DIR(0)="E" D ^DIR K DIR Q
;
CMSG W !!,?20,"Alerts have been cleared",! Q
;
TM S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHT 4516 printed Dec 13, 2024@01:59:11 Page 2
DVBHT ;PKE/ISC-ALBANY; HINQ alert parser; 5/10/92 ; 3/9/06 4:18pm
+1 ;;4.0;HINQ;**12,18,20,56**;03/25/92
+2 ;
+3 ;call alert
ALERT IF '$DATA(ZTQUEUED)
HANG 1
WRITE $CHAR(7),".. Alert found."
+1 SET (I,Y)=0
SET XQAMSG=""
+2 FOR
SET Y=$ORDER(DVBDATA(Y))
if 'Y
QUIT
Begin DoDot:1
+3 SET $PIECE(DVBDATA,"^",I+1)=Y
+4 SET XQAMSG=XQAMSG_$SELECT(I:", ",1:"")_Y
SET I=I+1
+5 KILL DVBDATA(Y)
End DoDot:1
+6 SET XQAMSG="Screen"_$SELECT(I>1:"s ",1:" ")_XQAMSG
+7 ;
+8 DO MAILGP^DVBHT2
DO REQUSR^DVBHT2
+9 IF $DATA(XQA)'>9
SET XQA(DUZ)=""
+10 SET Y=DT
DO TM
+11 ;
+12 SET XQAMSG=$EXTRACT($PIECE(^DPT(DFN,0),"^")_" ",1,9)_" "_"("_$EXTRACT(^(0))_$EXTRACT($PIECE(^(0),"^",9),6,10)_")"_$SELECT('$LENGTH($EXTRACT($PIECE(^(0),"^",9),10)):":",1:"")_" HINQ Update . "_$EXTRACT(XQAMSG_" ",1,16)_$JUS
TIFY(Y,8)
+13 IF '$ORDER(XQA(0))
+14 IF '$TEST
SET XQAMSG=XQAMSG_" "_$EXTRACT($PIECE($PIECE(^VA(200,$ORDER(XQA(0)),0),"^"),","),1,10)
+15 ;
TST SET XQAID="DVB,"_DFN
+1 SET XQAROU="SETUP^DVBHT"
+2 ;S XQAFLG="R"
+3 SET XQADATA=DFN_"^"_DVBDATA
KILL DVBDATA
+4 ;
+5 DO SETUP^XQALERT
+6 ;set alert SET
SET $PIECE(^DVB(395.5,DFN,0),"^",6)=1
QUIT
+7 ;
+8 ;entry action from alert
SETUP SET DVBDATA=XQADATA
KILL XQADATA,XQAKILL,DVBNOALR
+1 SET Y=+$PIECE(DVBDATA,"^")
if 'Y
QUIT
+2 SET DFN=Y
SET DVBDATA=$PIECE(DVBDATA,"^",2,99)
+3 IF '$DATA(^DVB(395.5,Y,0))
SET XQAKILL=0
DO KIL
QUIT
+4 IF '$PIECE(^DVB(395.5,Y,0),"^",6)
Begin DoDot:1
+5 WRITE !,?15," another request pending, alert cleared"
+6 SET XQAKILL=0
End DoDot:1
DO KIL
QUIT
+7 IF '$DATA(^XUSEC("DG ELIGIBILITY",DUZ))
Begin DoDot:1
+8 SET XQAKILL=1
+9 DO DISPLAY
+10 DO PAGE
End DoDot:1
DO KIL
QUIT
+11 ;if no to hinq screens
+12 IF $PIECE(^DVB(395,1,0),"^",5)="n"
Begin DoDot:1
+13 SET XQAKILL=0
SET DVBJ2=1
+14 DO TEM^DVBHIQR
IF $DATA(DVBERCS)
KILL XQAKILL
QUIT
+15 DO ACHK^DVBHT1
+16 DO DISPLAY
+17 IF $DATA(DVBNOALR)
DO PAGE
DO FILE^DVBHQUP
QUIT
+18 DO ACKNOW
+19 IF $DATA(DVBNOALR)
DO FILE^DVBHQUP
QUIT
+20 KILL XQAKILL
End DoDot:1
DO END
QUIT
+21 ;
+22 DO A^DVBHUTIL
WRITE !
+23 KILL DVBDIQ
+24 ;
UPD LOCK +^DPT(DFN):3
IF $TEST
Begin DoDot:1
+1 NEW XQAID
+2 SET DIE="^DPT("
SET (DA,DFN)=+Y
SET DR="[DVBHINQ UPDATE]"
SET DVBJ2=0
DO TEM^DVBHIQR
+3 NEW DVBQT
+4 IF '$DATA(DVBERCS)
DO CHKID^DVBHQD1
IF DVBQT
Begin DoDot:2
+5 NEW DVBTMP1,DVBTMP2
+6 SET DVBTMP1=$GET(DVBNOALR)
+7 SET DVBTMP2=$GET(DVBJ2)
+8 SET DVBNOALR=";4///a;5////"_DUZ_";6///N"
SET DVBJ2=1
+9 DO FILE^DVBHQUP
+10 SET DVBNOALR=DVBTMP1
+11 SET DVBJ2=DVBTMP2
End DoDot:2
QUIT
+12 if '$DATA(DVBERCS)
DO ^DIE
KILL DIE,DR,DA
QUIT
End DoDot:1
+13 IF '$TEST
WRITE !?3,"This patient data is being edited by another user"
HANG 1
GOTO END
+14 LOCK -^DPT(DFN)
+15 ;
+16 ;patient updated, alerts filed in up
IF DVBJ2
Begin DoDot:1
+17 WRITE !!,"Checking the alerts ."
+18 DO ACHK^DVBHT1
+19 IF $DATA(DVBNOALR)
Begin DoDot:2
+20 SET DVBNOALR=";4///c;5////"_DUZ_";6///N"
+21 WRITE ". OK"
End DoDot:2
+22 IF '$TEST
Begin DoDot:2
+23 WRITE ". need more changes"
+24 DO DISPLAY
+25 DO ACKNOW
End DoDot:2
+26 HANG 1
End DoDot:1
+27 ;patient not updated
IF '$TEST
Begin DoDot:1
+28 IF $DATA(DVBNOALR)
Begin DoDot:2
+29 IF DVBNOALR]""
DO FILE^DVBHQUP
+30 ;;;D DISPLAY
End DoDot:2
QUIT
+31 DO ACHK^DVBHT1
+32 DO DISPLAY
IF $DATA(DVBNOALR)
QUIT
+33 DO ACKNOW
+34 IF $DATA(DVBNOALR)
IF DVBNOALR]""
DO FILE^DVBHQUP
End DoDot:1
+35 ;
+36 KILL DVBDIQ
DO C^DVBHQUP
+37 ;
END SET END="N DVBNOALR,XQAID D KILL^XUSCLEAN"
XECUTE END
+1 IF $DATA(DVBNOALR)
SET XQAKILL=0
KIL KILL DVBNOALR,DVBDATA,DFN,DVBJ2,DR,DVBDIQ,LP2,DIC,DIQ,DA,D0
QUIT
+1 ;
+2 ;display alert
DISPLAY if '$DATA(DVBDATA)
QUIT
IF '$LENGTH($PIECE(DVBDATA,"^",11))
DO CMSG
QUIT
INFO ;
+1 ;;Diagnostic Ver.Ind.: NO Verify Service Connections at RO
+2 IF '$DATA(DVBDIQ(2,DFN,.01,"E"))
SET DR=".01;.09"
DO DIQDR^DVBHT1
+3 SET DVBALERT="LOAD/EDIT Screen"_$SELECT(DVBDATA'["SC D":" 7",1:"s 7, 11")
+4 WRITE !," ----------------------------------------------------------------------------"
+5 WRITE !,"| ",DVBDIQ(2,DFN,.01,"E")," "
+6 WRITE $EXTRACT(DVBDIQ(2,DFN,.01,"E")),$EXTRACT(DVBDIQ(2,DFN,.09,"E"),6,10)
+7 WRITE ?39,DVBALERT,?69,"HINQ"
+8 WRITE ?77,"|",!
+9 IF $DATA(XQAKILL)
+10 FOR I=11:1
SET DVBALERT=$PIECE(DVBDATA,"^",I)_"'"
if 'DVBALERT
QUIT
Begin DoDot:1
+11 if $X<10
WRITE "|",?6
+12 IF $EXTRACT(DVBALERT,2)="+"
WRITE "HINQ has data not in patient file `"
+13 IF $EXTRACT(DVBALERT,2)="-"
WRITE "Patient file has data not in HINQ `"
+14 IF $EXTRACT(DVBALERT,2)="?"
WRITE "HINQ, Patient file are different `"
+15 IF $EXTRACT(DVBALERT,2)="X"
Begin DoDot:2
+16 IF $EXTRACT(DVBALERT,3)
WRITE $PIECE($TEXT(INFO+$EXTRACT(DVBALERT,3)),";;",2)
+17 SET DVBALERT=$EXTRACT(DVBALERT)
End DoDot:2
+18 WRITE $EXTRACT(DVBALERT,3,$LENGTH(DVBALERT))
+19 WRITE ?66,"Screen (",$EXTRACT(DVBALERT),")",?77,"|",!
End DoDot:1
+20 WRITE " ----------------------------------------------------------------------------"
+21 KILL DVBALERT
+22 QUIT
ACKNOW KILL DIR
SET DIR("A")="Do you wish to acknowledge inconsistencies and clear this Alert ? "
+1 SET DIR("B")="No"
+2 SET DIR("?",1)="If the patient file has data that should not be updated by HINQ, this Alert"
+3 SET DIR("?",2)="can be acknowledged and cleared by entering 'Y'es. Otherwise, just continue"
+4 SET DIR("?")="Press RETURN to continue,'Y'es to acknowledge, '^' to exit:"
+5 SET DIR(0)="YAO"
DO ^DIR
KILL DIR
if 'Y
QUIT
+6 SET DVBNOALR=";4///a;5////"_DUZ_";6///N"
+7 WRITE !!?6," Alert will be cleared"
HANG 1
QUIT
+8 ;
PAGE KILL DVBALERT
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+1 ;
CMSG WRITE !!,?20,"Alerts have been cleared",!
QUIT
+1 ;
TM SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_$PIECE("@"_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12),"^",Y[".")
QUIT
