| [613] | 1 | AFJXVER ;FO-OAKLAND/GMB-VERIFY NHE DATA MESSAGE IS VALID ;1/09/01 13:51
|
|---|
| 2 | ;;5.1;Network Health Exchange;**26,31**;Jan 23, 1996
|
|---|
| 3 | ; Totally rewritten 11/2001. (Previously CIOFO-SLC/RJS.)
|
|---|
| 4 | ; Entry point:
|
|---|
| 5 | ; ENTER - Invoked by option AFJX PATID REPORT
|
|---|
| 6 | ENTER ;
|
|---|
| 7 | D EN^XUTMDEVQ("ALL^AFJXVER","Network Health Exchange Data Message Report")
|
|---|
| 8 | Q
|
|---|
| 9 | ALL ; ALL MESSAGES
|
|---|
| 10 | N AXBSKT,AXCNT,AXMZ,AXDATA,AXDATE,AXLIST,AXMZ,AXSEG,AXSITE,AXNHEDUZ,AXBSKTN,AXTXT
|
|---|
| 11 | W !!,"Network Health Exchange Data Message report"
|
|---|
| 12 | W !,?20,"for ",^XMB("NETNAME"),!,?24,"on ",$$HTE^XLFDT($H)
|
|---|
| 13 | S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
|
|---|
| 14 | I 'AXNHEDUZ W !,"NETWORK,HEALTH EXCHANGE user not in New Person file." Q
|
|---|
| 15 | W !!,"Checking NETWORK,HEALTH EXCHANGE messages..."
|
|---|
| 16 | I '$D(^XMB(3.7,AXNHEDUZ)) W !,"No Mail Box for this user defined..." Q
|
|---|
| 17 | S AXBSKT=.9
|
|---|
| 18 | F S AXBSKT=$O(^XMB(3.7,AXNHEDUZ,2,AXBSKT)) Q:'AXBSKT D ; Loop through mail baskets.
|
|---|
| 19 | . S AXBSKTN=$$BSKTNAME^XMXUTIL(AXNHEDUZ,AXBSKT)
|
|---|
| 20 | . S AXLIST(2,AXBSKTN)=0
|
|---|
| 21 | . W !,?3,"Checking ",AXBSKTN," basket..."
|
|---|
| 22 | . S (AXMZ,AXCNT)=0
|
|---|
| 23 | . F S AXMZ=$O(^XMB(3.7,AXNHEDUZ,2,AXBSKT,1,AXMZ)) Q:'AXMZ D ; Check each message.
|
|---|
| 24 | . . S AXCNT=AXCNT+1 W:($X>50) ! W:'(AXCNT#100) "."
|
|---|
| 25 | . . S AXLIST(2,AXBSKTN)=AXLIST(2,AXBSKTN)+1 ; Update basket Message Counter
|
|---|
| 26 | . . S AXDATA=$$MSG(AXMZ) Q:'$L(AXDATA)
|
|---|
| 27 | . . S AXLIST(1,$P(AXDATA,U,2),"T")=$G(AXLIST(1,$P(AXDATA,U,2),"T"))+1
|
|---|
| 28 | . . S AXTXT=$$VALID(AXMZ)
|
|---|
| 29 | . . I AXTXT D Q ; Message is valid.
|
|---|
| 30 | . . . S AXLIST(1,$P(AXDATA,U,2),"V")=$G(AXLIST(1,$P(AXDATA,U,2),"V"))+1
|
|---|
| 31 | . . ;W !," Data discrepancy in message #",+AXMZ," ",$P(AXTXT,U,2)
|
|---|
| 32 | . . ; Message has data discrepancies.
|
|---|
| 33 | . . S AXLIST(1,$P(AXDATA,U,2),+AXDATA)=$G(AXLIST(1,$P(AXDATA,U,2),+AXDATA))+1
|
|---|
| 34 | . . S AXLIST(1,$P(AXDATA,U,2),+AXDATA,AXMZ)=$P(AXTXT,U,2)
|
|---|
| 35 | . . S AXLIST(1,$P(AXDATA,U,2),"N")=$G(AXLIST(1,$P(AXDATA,U,2),"N"))+1
|
|---|
| 36 | W !!,"Message count"
|
|---|
| 37 | S AXBSKTN=""
|
|---|
| 38 | F S AXBSKTN=$O(AXLIST(2,AXBSKTN)) Q:AXBSKTN="" D
|
|---|
| 39 | . W !,?3,$J(+AXLIST(2,AXBSKTN),8)
|
|---|
| 40 | . W " message",$S((+AXLIST(2,AXBSKTN)=1):"",1:"s")
|
|---|
| 41 | . W " in the '",AXBSKTN,"' basket."
|
|---|
| 42 | W !!,"Site",?49,$J("Not Valid",10),$J("Valid",10),$J("Total",10),!
|
|---|
| 43 | S AXSITE=""
|
|---|
| 44 | F S AXSITE=$O(AXLIST(1,AXSITE)) Q:AXSITE="" D
|
|---|
| 45 | . W !,$E(AXSITE,1,48),?49
|
|---|
| 46 | . F AXSEG="N","V","T" W $J(+$G(AXLIST(1,AXSITE,AXSEG)),10)
|
|---|
| 47 | . S AXDATE=0
|
|---|
| 48 | . F S AXDATE=$O(AXLIST(1,AXSITE,AXDATE)) Q:'AXDATE D
|
|---|
| 49 | . . W !,?3,"Problems for ",$$FMTE^XLFDT(AXDATE,5),": ",$G(AXLIST(1,AXSITE,AXDATE))
|
|---|
| 50 | . . S AXMZ=0
|
|---|
| 51 | . . F S AXMZ=$O(AXLIST(1,AXSITE,AXDATE,AXMZ)) Q:'AXMZ D
|
|---|
| 52 | . . . W !,$J(AXMZ,15)," ",AXLIST(1,AXSITE,AXDATE,AXMZ)
|
|---|
| 53 | Q
|
|---|
| 54 | VALID(AXMZ) ; ONE MESSAGE
|
|---|
| 55 | N AXAGE,AXCHKAGE,AXDOB,AXLINE,AXDATE,AXTXT
|
|---|
| 56 | Q:'$O(^XMB(3.9,AXMZ,2,0)) 1 ; No text in message?
|
|---|
| 57 | S (AXDATE,AXDOB,AXAGE,AXCHKAGE)="" ; Initialize key fields.
|
|---|
| 58 | S AXLINE=.99999999
|
|---|
| 59 | F S AXLINE=$O(^XMB(3.9,AXMZ,2,AXLINE)) Q:'AXLINE D Q:($L(AXDOB)&$L(AXAGE)&$L(AXDATE)) ; Look for key fields.
|
|---|
| 60 | . S AXTXT=$G(^XMB(3.9,AXMZ,2,AXLINE,0)) Q:$L(AXTXT)<5 ; Get a line and Quit if not long enough.
|
|---|
| 61 | . S AXTXT=$$UP^XLFSTR(AXTXT)
|
|---|
| 62 | . I '$L(AXDOB),AXTXT["DOB: " S AXDOB=$$SPACES($P(AXTXT,"DOB: ",2)) Q
|
|---|
| 63 | . I '$L(AXAGE),AXTXT["AGE: " S AXAGE=$$SPACES($P(AXTXT,"AGE: ",2)) Q
|
|---|
| 64 | . I '$L(AXDATE),AXTXT["***CONFIDENTIAL PATIENT DATA FROM" S AXDATE=$$SPACES($P(AXTXT,"*",$L(AXTXT,"*")))
|
|---|
| 65 | Q:'($L(AXAGE)&$L(AXDOB)&$L(AXDATE)) 1 ; Quit if missing a key field.
|
|---|
| 66 | S AXDATE=$$DT2INT(AXDATE),AXDOB=$$DT2INT(AXDOB)
|
|---|
| 67 | I AXDATE=-1!(AXDOB=-1) Q 1 ; Conversion problem in one of the dates.
|
|---|
| 68 | S AXCHKAGE=$$FMDIFF^XLFDT(AXDATE,AXDOB,1)\365.25 ; Calculate age of patient.
|
|---|
| 69 | Q:AXCHKAGE=AXAGE 1 ; If calculated age equals displayed age then data is valid.
|
|---|
| 70 | Q "0^Age: "_AXAGE_" DOB: "_$$FMTE^XLFDT(AXDOB,5)_" DOR: "_$$FMTE^XLFDT(AXDATE,5)_" Actual Age: "_AXCHKAGE ; If not then return reason.
|
|---|
| 71 | MSG(AXMZ) ;
|
|---|
| 72 | N AXREC,AXFROM,AXDATE,AXSITE
|
|---|
| 73 | Q:'$O(^XMB(3.9,AXMZ,2,0)) "" ; No text in message?
|
|---|
| 74 | S AXREC=$G(^XMB(3.9,AXMZ,0)) Q:AXREC="" ""
|
|---|
| 75 | S AXFROM=$P(AXREC,U,2)
|
|---|
| 76 | S AXSITE=$S(AXFROM["@":$P($P(AXFROM,"@",2),">"),1:^XMB("NETNAME"))
|
|---|
| 77 | S AXDATE=$P(AXREC,U,3)
|
|---|
| 78 | I AXDATE?7N1".".N S AXDATE=$P(AXDATE,".")
|
|---|
| 79 | E D
|
|---|
| 80 | . S AXDATE=$$CONVERT^XMXUTIL1(AXDATE)
|
|---|
| 81 | . I AXDATE=-1 S AXDATE=0
|
|---|
| 82 | Q AXDATE_U_AXSITE
|
|---|
| 83 | DT2INT(X) ; Convert date from external to internal fileman format.
|
|---|
| 84 | N Y,%DT S %DT="T" D ^%DT Q Y
|
|---|
| 85 | SPACES(X) ; Get rid of leading and trailing spaces
|
|---|
| 86 | F Q:'$L(X) Q:$E(X,1)'=" " S X=$E(X,2,$L(X)) ; Leading spaces
|
|---|
| 87 | F Q:'$L(X) Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1) ; Trailing spaces
|
|---|
| 88 | Q X
|
|---|
