IVM2034Z ;HEC/KSD - Correction software for HL7 Upgrade ; 7/10/02 10:13am
;;2.0;INCOME VERIFICATION MATCH;**60,59**;
Q
;
EN ; fix the ACK routine for the QRY-Z10 and QRY-Z11 in the
; server protocol.
;
N SITE,PROT,DGENDA,DATA,ERROR,RETURN,FILE
;
S FILE=101
S SITE=$P($$SITE^VASITE,"^",3)
S PROTSTUB="VAMC "_SITE_" QRY-"
S DATA(772)="D ORF^IVMCM"
;
; Update Financial Query
S PROTOCOL=PROTSTUB_"Z10 SERVER"
S DGENDA=+$O(^ORD(101,"B",PROTOCOL,""))
S DATA(.01)=PROTOCOL
S RETURN=$$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
I ERROR'=""!(+RETURN=0) W "ERROR in Updating Financial Query" Q
;
; Update Enrollment/Eligibility Query
S PROTOCOL=PROTSTUB_"Z11 SERVER"
S DGENDA=+$O(^ORD(101,"B",PROTOCOL,""))
S DATA(.01)=PROTOCOL
S RETURN=$$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
I ERROR'=""!(+RETURN=0) W "ERROR in Updating Enrollment/Eligibility Query" Q
Q
;
ADSIN ;Entry Point;
;The ADS x-ref is being deleted by the #301.6 Status field Kill
;logic when the ORU-Z07 is retransmitted after 3 days. When the
;ORU-Z07 ACK is returning the Message Control ID is unable to find
;the original ORU-Z07. Code falls into wrong processing and gets
;an allocation error.
;1. modify Kill logic to NOT remove x-ref (done by patch)
;2. reset ADS x-ref for 30 days into the past
N RTN,IEN,STOP,TRANSDT,BEGDT,ENDDT,MSGCID,X1,X2,NO2,NODE
;
S RTN="IVM2034Z"
S DESC="Temporary re-setting of ADS x-ref"
S ^XTMP(RTN,0)=$$HTFM^XLFDT($H+90,1)_"^"_$$DT^XLFDT()_"^"_DESC
;
; Reset the ADS x-ref beginning at 30 days in the past.
S (NOW,X1)=$P($$NOW^XLFDT,"."),X2=-30
D C^%DTC
S BEGDT=X
S X1=NOW,X2=-1
D C^%DTC
S ENDDT=X
S (IEN,STOP)=0
F S IEN=$O(^IVM(301.6,IEN)) Q:IEN="" D Q:STOP
. S NODE=$G(^IVM(301.6,IEN,0))
. S TRANSDT=+$P($P(NODE,"^",2),".")
. Q:TRANSDT<BEGDT
. I TRANSDT>ENDDT S STOP=1 Q
. S MSGCID=$P(NODE,"^",5)
. S ^IVM(301.6,"ADS",MSGCID,IEN)=""
. S ^XTMP(RTN,MSGCID,IEN)=""
Q
;
ADSOUT ;Entry Point;
;The ADSIN line label reset the ADS x-ref for entries a week
;before the time of running. This software will undo that
;change. It will remove all the ADS x-ref's that were added.
;
N RTN,IEN,MSGCID
;
S RTN="IVM2034Z"
;
; Remove the ADS x-ref's set by the ADSIN running.
;
S MSGCID=0
F S MSGCID=$O(^XTMP(RTN,MSGCID)) Q:MSGCID="" D
. S IEN=""
. F S IEN=$O(^XTMP(RTN,MSGCID,IEN)) Q:IEN="" D
. . K ^IVM(301.6,"ADS",MSGCID,IEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM2034Z 2463 printed Apr 09, 2024@21:01:24 Page 2
IVM2034Z ;HEC/KSD - Correction software for HL7 Upgrade ; 7/10/02 10:13am
+1 ;;2.0;INCOME VERIFICATION MATCH;**60,59**;
+2 QUIT
+3 ;
EN ; fix the ACK routine for the QRY-Z10 and QRY-Z11 in the
+1 ; server protocol.
+2 ;
+3 NEW SITE,PROT,DGENDA,DATA,ERROR,RETURN,FILE
+4 ;
+5 SET FILE=101
+6 SET SITE=$PIECE($$SITE^VASITE,"^",3)
+7 SET PROTSTUB="VAMC "_SITE_" QRY-"
+8 SET DATA(772)="D ORF^IVMCM"
+9 ;
+10 ; Update Financial Query
+11 SET PROTOCOL=PROTSTUB_"Z10 SERVER"
+12 SET DGENDA=+$ORDER(^ORD(101,"B",PROTOCOL,""))
+13 SET DATA(.01)=PROTOCOL
+14 SET RETURN=$$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+15 IF ERROR'=""!(+RETURN=0)
WRITE "ERROR in Updating Financial Query"
QUIT
+16 ;
+17 ; Update Enrollment/Eligibility Query
+18 SET PROTOCOL=PROTSTUB_"Z11 SERVER"
+19 SET DGENDA=+$ORDER(^ORD(101,"B",PROTOCOL,""))
+20 SET DATA(.01)=PROTOCOL
+21 SET RETURN=$$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+22 IF ERROR'=""!(+RETURN=0)
WRITE "ERROR in Updating Enrollment/Eligibility Query"
QUIT
+23 QUIT
+24 ;
ADSIN ;Entry Point;
+1 ;The ADS x-ref is being deleted by the #301.6 Status field Kill
+2 ;logic when the ORU-Z07 is retransmitted after 3 days. When the
+3 ;ORU-Z07 ACK is returning the Message Control ID is unable to find
+4 ;the original ORU-Z07. Code falls into wrong processing and gets
+5 ;an allocation error.
+6 ;1. modify Kill logic to NOT remove x-ref (done by patch)
+7 ;2. reset ADS x-ref for 30 days into the past
+8 NEW RTN,IEN,STOP,TRANSDT,BEGDT,ENDDT,MSGCID,X1,X2,NO2,NODE
+9 ;
+10 SET RTN="IVM2034Z"
+11 SET DESC="Temporary re-setting of ADS x-ref"
+12 SET ^XTMP(RTN,0)=$$HTFM^XLFDT($HOROLOG+90,1)_"^"_$$DT^XLFDT()_"^"_DESC
+13 ;
+14 ; Reset the ADS x-ref beginning at 30 days in the past.
+15 SET (NOW,X1)=$PIECE($$NOW^XLFDT,".")
SET X2=-30
+16 DO C^%DTC
+17 SET BEGDT=X
+18 SET X1=NOW
SET X2=-1
+19 DO C^%DTC
+20 SET ENDDT=X
+21 SET (IEN,STOP)=0
+22 FOR
SET IEN=$ORDER(^IVM(301.6,IEN))
if IEN=""
QUIT
Begin DoDot:1
+23 SET NODE=$GET(^IVM(301.6,IEN,0))
+24 SET TRANSDT=+$PIECE($PIECE(NODE,"^",2),".")
+25 if TRANSDT<BEGDT
QUIT
+26 IF TRANSDT>ENDDT
SET STOP=1
QUIT
+27 SET MSGCID=$PIECE(NODE,"^",5)
+28 SET ^IVM(301.6,"ADS",MSGCID,IEN)=""
+29 SET ^XTMP(RTN,MSGCID,IEN)=""
End DoDot:1
if STOP
QUIT
+30 QUIT
+31 ;
ADSOUT ;Entry Point;
+1 ;The ADSIN line label reset the ADS x-ref for entries a week
+2 ;before the time of running. This software will undo that
+3 ;change. It will remove all the ADS x-ref's that were added.
+4 ;
+5 NEW RTN,IEN,MSGCID
+6 ;
+7 SET RTN="IVM2034Z"
+8 ;
+9 ; Remove the ADS x-ref's set by the ADSIN running.
+10 ;
+11 SET MSGCID=0
+12 FOR
SET MSGCID=$ORDER(^XTMP(RTN,MSGCID))
if MSGCID=""
QUIT
Begin DoDot:1
+13 SET IEN=""
+14 FOR
SET IEN=$ORDER(^XTMP(RTN,MSGCID,IEN))
if IEN=""
QUIT
Begin DoDot:2
+15 KILL ^IVM(301.6,"ADS",MSGCID,IEN)
End DoDot:2
End DoDot:1
+16 QUIT
