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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAFJXVER 4522 printed Dec 13, 2024@02:17:56 Page 2
AFJXVER ;FO-OAKLAND/GMB-VERIFY NHE DATA MESSAGE IS VALID ;1/09/01 13:51
+1 ;;5.1;Network Health Exchange;**26,31**;Jan 23, 1996
+2 ; Totally rewritten 11/2001. (Previously CIOFO-SLC/RJS.)
+3 ; Entry point:
+4 ; ENTER - Invoked by option AFJX PATID REPORT
ENTER ;
+1 DO EN^XUTMDEVQ("ALL^AFJXVER","Network Health Exchange Data Message Report")
+2 QUIT
ALL ; ALL MESSAGES
+1 NEW AXBSKT,AXCNT,AXMZ,AXDATA,AXDATE,AXLIST,AXMZ,AXSEG,AXSITE,AXNHEDUZ,AXBSKTN,AXTXT
+2 WRITE !!,"Network Health Exchange Data Message report"
+3 WRITE !,?20,"for ",^XMB("NETNAME"),!,?24,"on ",$$HTE^XLFDT($HOROLOG)
+4 SET AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
+5 IF 'AXNHEDUZ
WRITE !,"NETWORK,HEALTH EXCHANGE user not in New Person file."
QUIT
+6 WRITE !!,"Checking NETWORK,HEALTH EXCHANGE messages..."
+7 IF '$DATA(^XMB(3.7,AXNHEDUZ))
WRITE !,"No Mail Box for this user defined..."
QUIT
+8 SET AXBSKT=.9
+9 ; Loop through mail baskets.
FOR
SET AXBSKT=$ORDER(^XMB(3.7,AXNHEDUZ,2,AXBSKT))
if 'AXBSKT
QUIT
Begin DoDot:1
+10 SET AXBSKTN=$$BSKTNAME^XMXUTIL(AXNHEDUZ,AXBSKT)
+11 SET AXLIST(2,AXBSKTN)=0
+12 WRITE !,?3,"Checking ",AXBSKTN," basket..."
+13 SET (AXMZ,AXCNT)=0
+14 ; Check each message.
FOR
SET AXMZ=$ORDER(^XMB(3.7,AXNHEDUZ,2,AXBSKT,1,AXMZ))
if 'AXMZ
QUIT
Begin DoDot:2
+15 SET AXCNT=AXCNT+1
if ($X>50)
WRITE !
if '(AXCNT#100)
WRITE "."
+16 ; Update basket Message Counter
SET AXLIST(2,AXBSKTN)=AXLIST(2,AXBSKTN)+1
+17 SET AXDATA=$$MSG(AXMZ)
if '$LENGTH(AXDATA)
QUIT
+18 SET AXLIST(1,$PIECE(AXDATA,U,2),"T")=$GET(AXLIST(1,$PIECE(AXDATA,U,2),"T"))+1
+19 SET AXTXT=$$VALID(AXMZ)
+20 ; Message is valid.
IF AXTXT
Begin DoDot:3
+21 SET AXLIST(1,$PIECE(AXDATA,U,2),"V")=$GET(AXLIST(1,$PIECE(AXDATA,U,2),"V"))+1
End DoDot:3
QUIT
+22 ;W !," Data discrepancy in message #",+AXMZ," ",$P(AXTXT,U,2)
+23 ; Message has data discrepancies.
+24 SET AXLIST(1,$PIECE(AXDATA,U,2),+AXDATA)=$GET(AXLIST(1,$PIECE(AXDATA,U,2),+AXDATA))+1
+25 SET AXLIST(1,$PIECE(AXDATA,U,2),+AXDATA,AXMZ)=$PIECE(AXTXT,U,2)
+26 SET AXLIST(1,$PIECE(AXDATA,U,2),"N")=$GET(AXLIST(1,$PIECE(AXDATA,U,2),"N"))+1
End DoDot:2
End DoDot:1
+27 WRITE !!,"Message count"
+28 SET AXBSKTN=""
+29 FOR
SET AXBSKTN=$ORDER(AXLIST(2,AXBSKTN))
if AXBSKTN=""
QUIT
Begin DoDot:1
+30 WRITE !,?3,$JUSTIFY(+AXLIST(2,AXBSKTN),8)
+31 WRITE " message",$SELECT((+AXLIST(2,AXBSKTN)=1):"",1:"s")
+32 WRITE " in the '",AXBSKTN,"' basket."
End DoDot:1
+33 WRITE !!,"Site",?49,$JUSTIFY("Not Valid",10),$JUSTIFY("Valid",10),$JUSTIFY("Total",10),!
+34 SET AXSITE=""
+35 FOR
SET AXSITE=$ORDER(AXLIST(1,AXSITE))
if AXSITE=""
QUIT
Begin DoDot:1
+36 WRITE !,$EXTRACT(AXSITE,1,48),?49
+37 FOR AXSEG="N","V","T"
WRITE $JUSTIFY(+$GET(AXLIST(1,AXSITE,AXSEG)),10)
+38 SET AXDATE=0
+39 FOR
SET AXDATE=$ORDER(AXLIST(1,AXSITE,AXDATE))
if 'AXDATE
QUIT
Begin DoDot:2
+40 WRITE !,?3,"Problems for ",$$FMTE^XLFDT(AXDATE,5),": ",$GET(AXLIST(1,AXSITE,AXDATE))
+41 SET AXMZ=0
+42 FOR
SET AXMZ=$ORDER(AXLIST(1,AXSITE,AXDATE,AXMZ))
if 'AXMZ
QUIT
Begin DoDot:3
+43 WRITE !,$JUSTIFY(AXMZ,15)," ",AXLIST(1,AXSITE,AXDATE,AXMZ)
End DoDot:3
End DoDot:2
End DoDot:1
+44 QUIT
VALID(AXMZ) ; ONE MESSAGE
+1 NEW AXAGE,AXCHKAGE,AXDOB,AXLINE,AXDATE,AXTXT
+2 ; No text in message?
if '$ORDER(^XMB(3.9,AXMZ,2,0))
QUIT 1
+3 ; Initialize key fields.
SET (AXDATE,AXDOB,AXAGE,AXCHKAGE)=""
+4 SET AXLINE=.99999999
+5 ; Look for key fields.
FOR
SET AXLINE=$ORDER(^XMB(3.9,AXMZ,2,AXLINE))
if 'AXLINE
QUIT
Begin DoDot:1
+6 ; Get a line and Quit if not long enough.
SET AXTXT=$GET(^XMB(3.9,AXMZ,2,AXLINE,0))
if $LENGTH(AXTXT)<5
QUIT
+7 SET AXTXT=$$UP^XLFSTR(AXTXT)
+8 IF '$LENGTH(AXDOB)
IF AXTXT["DOB: "
SET AXDOB=$$SPACES($PIECE(AXTXT,"DOB: ",2))
QUIT
+9 IF '$LENGTH(AXAGE)
IF AXTXT["AGE: "
SET AXAGE=$$SPACES($PIECE(AXTXT,"AGE: ",2))
QUIT
+10 IF '$LENGTH(AXDATE)
IF AXTXT["***CONFIDENTIAL PATIENT DATA FROM"
SET AXDATE=$$SPACES($PIECE(AXTXT,"*",$LENGTH(AXTXT,"*")))
End DoDot:1
if ($LENGTH(AXDOB)&$LENGTH(AXAGE)&$LENGTH(AXDATE))
QUIT
+11 ; Quit if missing a key field.
if '($LENGTH(AXAGE)&$LENGTH(AXDOB)&$LENGTH(AXDATE))
QUIT 1
+12 SET AXDATE=$$DT2INT(AXDATE)
SET AXDOB=$$DT2INT(AXDOB)
+13 ; Conversion problem in one of the dates.
IF AXDATE=-1!(AXDOB=-1)
QUIT 1
+14 ; Calculate age of patient.
SET AXCHKAGE=$$FMDIFF^XLFDT(AXDATE,AXDOB,1)\365.25
+15 ; If calculated age equals displayed age then data is valid.
if AXCHKAGE=AXAGE
QUIT 1
+16 ; If not then return reason.
QUIT "0^Age: "_AXAGE_" DOB: "_$$FMTE^XLFDT(AXDOB,5)_" DOR: "_$$FMTE^XLFDT(AXDATE,5)_" Actual Age: "_AXCHKAGE
MSG(AXMZ) ;
+1 NEW AXREC,AXFROM,AXDATE,AXSITE
+2 ; No text in message?
if '$ORDER(^XMB(3.9,AXMZ,2,0))
QUIT ""
+3 SET AXREC=$GET(^XMB(3.9,AXMZ,0))
if AXREC=""
QUIT ""
+4 SET AXFROM=$PIECE(AXREC,U,2)
+5 SET AXSITE=$SELECT(AXFROM["@":$PIECE($PIECE(AXFROM,"@",2),">"),1:^XMB("NETNAME"))
+6 SET AXDATE=$PIECE(AXREC,U,3)
+7 IF AXDATE?7N1".".N
SET AXDATE=$PIECE(AXDATE,".")
+8 IF '$TEST
Begin DoDot:1
+9 SET AXDATE=$$CONVERT^XMXUTIL1(AXDATE)
+10 IF AXDATE=-1
SET AXDATE=0
End DoDot:1
+11 QUIT AXDATE_U_AXSITE
DT2INT(X) ; Convert date from external to internal fileman format.
+1 NEW Y,%DT
SET %DT="T"
DO ^%DT
QUIT Y
SPACES(X) ; Get rid of leading and trailing spaces
+1 ; Leading spaces
FOR
if '$LENGTH(X)
QUIT
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 ; Trailing spaces
FOR
if '$LENGTH(X)
QUIT
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+3 QUIT X
