89 lines
4.3 KiB
Mathematica
89 lines
4.3 KiB
Mathematica
AFJXVER ;FO-OAKLAND/GMB-VERIFY NHE DATA MESSAGE IS VALID ;1/09/01 13:51
|
|
;;5.1;Network Health Exchange;**26,31**;Jan 23, 1996
|
|
; Totally rewritten 11/2001. (Previously CIOFO-SLC/RJS.)
|
|
; Entry point:
|
|
; ENTER - Invoked by option AFJX PATID REPORT
|
|
ENTER ;
|
|
D EN^XUTMDEVQ("ALL^AFJXVER","Network Health Exchange Data Message Report")
|
|
Q
|
|
ALL ; ALL MESSAGES
|
|
N AXBSKT,AXCNT,AXMZ,AXDATA,AXDATE,AXLIST,AXMZ,AXSEG,AXSITE,AXNHEDUZ,AXBSKTN,AXTXT
|
|
W !!,"Network Health Exchange Data Message report"
|
|
W !,?20,"for ",^XMB("NETNAME"),!,?24,"on ",$$HTE^XLFDT($H)
|
|
S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
|
|
I 'AXNHEDUZ W !,"NETWORK,HEALTH EXCHANGE user not in New Person file." Q
|
|
W !!,"Checking NETWORK,HEALTH EXCHANGE messages..."
|
|
I '$D(^XMB(3.7,AXNHEDUZ)) W !,"No Mail Box for this user defined..." Q
|
|
S AXBSKT=.9
|
|
F S AXBSKT=$O(^XMB(3.7,AXNHEDUZ,2,AXBSKT)) Q:'AXBSKT D ; Loop through mail baskets.
|
|
. S AXBSKTN=$$BSKTNAME^XMXUTIL(AXNHEDUZ,AXBSKT)
|
|
. S AXLIST(2,AXBSKTN)=0
|
|
. W !,?3,"Checking ",AXBSKTN," basket..."
|
|
. S (AXMZ,AXCNT)=0
|
|
. F S AXMZ=$O(^XMB(3.7,AXNHEDUZ,2,AXBSKT,1,AXMZ)) Q:'AXMZ D ; Check each message.
|
|
. . S AXCNT=AXCNT+1 W:($X>50) ! W:'(AXCNT#100) "."
|
|
. . S AXLIST(2,AXBSKTN)=AXLIST(2,AXBSKTN)+1 ; Update basket Message Counter
|
|
. . S AXDATA=$$MSG(AXMZ) Q:'$L(AXDATA)
|
|
. . S AXLIST(1,$P(AXDATA,U,2),"T")=$G(AXLIST(1,$P(AXDATA,U,2),"T"))+1
|
|
. . S AXTXT=$$VALID(AXMZ)
|
|
. . I AXTXT D Q ; Message is valid.
|
|
. . . S AXLIST(1,$P(AXDATA,U,2),"V")=$G(AXLIST(1,$P(AXDATA,U,2),"V"))+1
|
|
. . ;W !," Data discrepancy in message #",+AXMZ," ",$P(AXTXT,U,2)
|
|
. . ; Message has data discrepancies.
|
|
. . S AXLIST(1,$P(AXDATA,U,2),+AXDATA)=$G(AXLIST(1,$P(AXDATA,U,2),+AXDATA))+1
|
|
. . S AXLIST(1,$P(AXDATA,U,2),+AXDATA,AXMZ)=$P(AXTXT,U,2)
|
|
. . S AXLIST(1,$P(AXDATA,U,2),"N")=$G(AXLIST(1,$P(AXDATA,U,2),"N"))+1
|
|
W !!,"Message count"
|
|
S AXBSKTN=""
|
|
F S AXBSKTN=$O(AXLIST(2,AXBSKTN)) Q:AXBSKTN="" D
|
|
. W !,?3,$J(+AXLIST(2,AXBSKTN),8)
|
|
. W " message",$S((+AXLIST(2,AXBSKTN)=1):"",1:"s")
|
|
. W " in the '",AXBSKTN,"' basket."
|
|
W !!,"Site",?49,$J("Not Valid",10),$J("Valid",10),$J("Total",10),!
|
|
S AXSITE=""
|
|
F S AXSITE=$O(AXLIST(1,AXSITE)) Q:AXSITE="" D
|
|
. W !,$E(AXSITE,1,48),?49
|
|
. F AXSEG="N","V","T" W $J(+$G(AXLIST(1,AXSITE,AXSEG)),10)
|
|
. S AXDATE=0
|
|
. F S AXDATE=$O(AXLIST(1,AXSITE,AXDATE)) Q:'AXDATE D
|
|
. . W !,?3,"Problems for ",$$FMTE^XLFDT(AXDATE,5),": ",$G(AXLIST(1,AXSITE,AXDATE))
|
|
. . S AXMZ=0
|
|
. . F S AXMZ=$O(AXLIST(1,AXSITE,AXDATE,AXMZ)) Q:'AXMZ D
|
|
. . . W !,$J(AXMZ,15)," ",AXLIST(1,AXSITE,AXDATE,AXMZ)
|
|
Q
|
|
VALID(AXMZ) ; ONE MESSAGE
|
|
N AXAGE,AXCHKAGE,AXDOB,AXLINE,AXDATE,AXTXT
|
|
Q:'$O(^XMB(3.9,AXMZ,2,0)) 1 ; No text in message?
|
|
S (AXDATE,AXDOB,AXAGE,AXCHKAGE)="" ; Initialize key fields.
|
|
S AXLINE=.99999999
|
|
F S AXLINE=$O(^XMB(3.9,AXMZ,2,AXLINE)) Q:'AXLINE D Q:($L(AXDOB)&$L(AXAGE)&$L(AXDATE)) ; Look for key fields.
|
|
. S AXTXT=$G(^XMB(3.9,AXMZ,2,AXLINE,0)) Q:$L(AXTXT)<5 ; Get a line and Quit if not long enough.
|
|
. S AXTXT=$$UP^XLFSTR(AXTXT)
|
|
. I '$L(AXDOB),AXTXT["DOB: " S AXDOB=$$SPACES($P(AXTXT,"DOB: ",2)) Q
|
|
. I '$L(AXAGE),AXTXT["AGE: " S AXAGE=$$SPACES($P(AXTXT,"AGE: ",2)) Q
|
|
. I '$L(AXDATE),AXTXT["***CONFIDENTIAL PATIENT DATA FROM" S AXDATE=$$SPACES($P(AXTXT,"*",$L(AXTXT,"*")))
|
|
Q:'($L(AXAGE)&$L(AXDOB)&$L(AXDATE)) 1 ; Quit if missing a key field.
|
|
S AXDATE=$$DT2INT(AXDATE),AXDOB=$$DT2INT(AXDOB)
|
|
I AXDATE=-1!(AXDOB=-1) Q 1 ; Conversion problem in one of the dates.
|
|
S AXCHKAGE=$$FMDIFF^XLFDT(AXDATE,AXDOB,1)\365.25 ; Calculate age of patient.
|
|
Q:AXCHKAGE=AXAGE 1 ; If calculated age equals displayed age then data is valid.
|
|
Q "0^Age: "_AXAGE_" DOB: "_$$FMTE^XLFDT(AXDOB,5)_" DOR: "_$$FMTE^XLFDT(AXDATE,5)_" Actual Age: "_AXCHKAGE ; If not then return reason.
|
|
MSG(AXMZ) ;
|
|
N AXREC,AXFROM,AXDATE,AXSITE
|
|
Q:'$O(^XMB(3.9,AXMZ,2,0)) "" ; No text in message?
|
|
S AXREC=$G(^XMB(3.9,AXMZ,0)) Q:AXREC="" ""
|
|
S AXFROM=$P(AXREC,U,2)
|
|
S AXSITE=$S(AXFROM["@":$P($P(AXFROM,"@",2),">"),1:^XMB("NETNAME"))
|
|
S AXDATE=$P(AXREC,U,3)
|
|
I AXDATE?7N1".".N S AXDATE=$P(AXDATE,".")
|
|
E D
|
|
. S AXDATE=$$CONVERT^XMXUTIL1(AXDATE)
|
|
. I AXDATE=-1 S AXDATE=0
|
|
Q AXDATE_U_AXSITE
|
|
DT2INT(X) ; Convert date from external to internal fileman format.
|
|
N Y,%DT S %DT="T" D ^%DT Q Y
|
|
SPACES(X) ; Get rid of leading and trailing spaces
|
|
F Q:'$L(X) Q:$E(X,1)'=" " S X=$E(X,2,$L(X)) ; Leading spaces
|
|
F Q:'$L(X) Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1) ; Trailing spaces
|
|
Q X
|