| 1 | IVM2034Z ;HEC/KSD - Correction software for HL7 Upgrade ; 7/10/02 10:13am
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**60,59**;
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; fix the ACK routine for the QRY-Z10 and QRY-Z11 in the
|
|---|
| 6 | ; server protocol.
|
|---|
| 7 | ;
|
|---|
| 8 | N SITE,PROT,DGENDA,DATA,ERROR,RETURN,FILE
|
|---|
| 9 | ;
|
|---|
| 10 | S FILE=101
|
|---|
| 11 | S SITE=$P($$SITE^VASITE,"^",3)
|
|---|
| 12 | S PROTSTUB="VAMC "_SITE_" QRY-"
|
|---|
| 13 | S DATA(772)="D ORF^IVMCM"
|
|---|
| 14 | ;
|
|---|
| 15 | ; Update Financial Query
|
|---|
| 16 | S PROTOCOL=PROTSTUB_"Z10 SERVER"
|
|---|
| 17 | S DGENDA=+$O(^ORD(101,"B",PROTOCOL,""))
|
|---|
| 18 | S DATA(.01)=PROTOCOL
|
|---|
| 19 | S RETURN=$$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
|
|---|
| 20 | I ERROR'=""!(+RETURN=0) W "ERROR in Updating Financial Query" Q
|
|---|
| 21 | ;
|
|---|
| 22 | ; Update Enrollment/Eligibility Query
|
|---|
| 23 | S PROTOCOL=PROTSTUB_"Z11 SERVER"
|
|---|
| 24 | S DGENDA=+$O(^ORD(101,"B",PROTOCOL,""))
|
|---|
| 25 | S DATA(.01)=PROTOCOL
|
|---|
| 26 | S RETURN=$$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
|
|---|
| 27 | I ERROR'=""!(+RETURN=0) W "ERROR in Updating Enrollment/Eligibility Query" Q
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | ADSIN ;Entry Point;
|
|---|
| 31 | ;The ADS x-ref is being deleted by the #301.6 Status field Kill
|
|---|
| 32 | ;logic when the ORU-Z07 is retransmitted after 3 days. When the
|
|---|
| 33 | ;ORU-Z07 ACK is returning the Message Control ID is unable to find
|
|---|
| 34 | ;the original ORU-Z07. Code falls into wrong processing and gets
|
|---|
| 35 | ;an allocation error.
|
|---|
| 36 | ;1. modify Kill logic to NOT remove x-ref (done by patch)
|
|---|
| 37 | ;2. reset ADS x-ref for 30 days into the past
|
|---|
| 38 | N RTN,IEN,STOP,TRANSDT,BEGDT,ENDDT,MSGCID,X1,X2,NO2,NODE
|
|---|
| 39 | ;
|
|---|
| 40 | S RTN="IVM2034Z"
|
|---|
| 41 | S DESC="Temporary re-setting of ADS x-ref"
|
|---|
| 42 | S ^XTMP(RTN,0)=$$HTFM^XLFDT($H+90,1)_"^"_$$DT^XLFDT()_"^"_DESC
|
|---|
| 43 | ;
|
|---|
| 44 | ; Reset the ADS x-ref beginning at 30 days in the past.
|
|---|
| 45 | S (NOW,X1)=$P($$NOW^XLFDT,"."),X2=-30
|
|---|
| 46 | D C^%DTC
|
|---|
| 47 | S BEGDT=X
|
|---|
| 48 | S X1=NOW,X2=-1
|
|---|
| 49 | D C^%DTC
|
|---|
| 50 | S ENDDT=X
|
|---|
| 51 | S (IEN,STOP)=0
|
|---|
| 52 | F S IEN=$O(^IVM(301.6,IEN)) Q:IEN="" D Q:STOP
|
|---|
| 53 | . S NODE=$G(^IVM(301.6,IEN,0))
|
|---|
| 54 | . S TRANSDT=+$P($P(NODE,"^",2),".")
|
|---|
| 55 | . Q:TRANSDT<BEGDT
|
|---|
| 56 | . I TRANSDT>ENDDT S STOP=1 Q
|
|---|
| 57 | . S MSGCID=$P(NODE,"^",5)
|
|---|
| 58 | . S ^IVM(301.6,"ADS",MSGCID,IEN)=""
|
|---|
| 59 | . S ^XTMP(RTN,MSGCID,IEN)=""
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | ADSOUT ;Entry Point;
|
|---|
| 63 | ;The ADSIN line label reset the ADS x-ref for entries a week
|
|---|
| 64 | ;before the time of running. This software will undo that
|
|---|
| 65 | ;change. It will remove all the ADS x-ref's that were added.
|
|---|
| 66 | ;
|
|---|
| 67 | N RTN,IEN,MSGCID
|
|---|
| 68 | ;
|
|---|
| 69 | S RTN="IVM2034Z"
|
|---|
| 70 | ;
|
|---|
| 71 | ; Remove the ADS x-ref's set by the ADSIN running.
|
|---|
| 72 | ;
|
|---|
| 73 | S MSGCID=0
|
|---|
| 74 | F S MSGCID=$O(^XTMP(RTN,MSGCID)) Q:MSGCID="" D
|
|---|
| 75 | . S IEN=""
|
|---|
| 76 | . F S IEN=$O(^XTMP(RTN,MSGCID,IEN)) Q:IEN="" D
|
|---|
| 77 | . . K ^IVM(301.6,"ADS",MSGCID,IEN)
|
|---|
| 78 | Q
|
|---|
