source: FOIAVistA/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXVER.m@ 1654

Last change on this file since 1654 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1AFJXVER ;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
6ENTER ;
7 D EN^XUTMDEVQ("ALL^AFJXVER","Network Health Exchange Data Message Report")
8 Q
9ALL ; 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
54VALID(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.
71MSG(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
83DT2INT(X) ; Convert date from external to internal fileman format.
84 N Y,%DT S %DT="T" D ^%DT Q Y
85SPACES(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
Note: See TracBrowser for help on using the repository browser.