- 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 Jan 18, 2025@03:00:24 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