PXRMOUTM ; SLC/PKR - MyHealtheVet output. ;23-Mar-2015 10:38;DU
;;2.0;CLINICAL REMINDERS;**4,6,1001,17,1005**;Feb 04, 2005;Build 23
;;IHS/MSC/MGH Added lines for non-VA files
;================================================
FOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Do output for individual findings
;in the FINDING array.
I $D(IFIEVAL("TERM")) D MHVOUT^PXRMTERM(1,.IFIEVAL,.NFLINES,.TEXT) Q
N FTYPE
S FTYPE=$P(IFIEVAL("FINDING"),U,1)
S FTYPE=$P(FTYPE,";",2)
I FTYPE="AUTTEDT(" D MHVOUT^PXRMEDU(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="AUTTEXAM(" D MHVOUT^PXRMEXAM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="AUTTHF(" D MHVOUT^PXRMHF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="AUTTIMM(" D MHVOUT^PXRMIMM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="AUTTSK(" D MHVOUT^PXRMSKIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="GMRD(120.51," D MHVOUT^PXRMVITL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="LAB(60," D MHVOUT^PXRMLAB(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="ORD(101.43," D MHVOUT^PXRMORDR(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PS(50.605," D MHVOUT^PXRMDRCL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PSDRUG(" D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PS(55," D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PS(55NVA," D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PSRX(" D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PSNDF(50.6," D MHVOUT^PXRMDGEN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PXD(811.2," D MHVOUT^PXRMTAX(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PXRMD(802.4," D MHVOUT^PXRMFF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PXRMD(810.9," D MHVOUT^PXRMLOCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="PXRMD(811.4," D MHVOUT^PXRMCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="RAMIS(71," D MHVOUT^PXRMRAD(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
I FTYPE="YTT(601.71," D MHVOUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
;IHS/MSC/MGH Output for IHS V files
I FTYPE="^AUTTMSR(" D MHVOUT^BPXRMEA(INDENT,.IFIEVAL,.NLINE,.TEXT) Q
I FTYPE="^AUTTREFT(" D MHVOUT^BPXRMREF(INDENT,.IFIEVAL,.NLINE,.TEXT) Q
I FTYPE="^APCDACV(" D MHVOUT^BPXRMAS1(INDENT,.IFIEVAL,.NLINE,.TEXT) Q
Q
;
;================================================
MHVC(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL) ;Prepare the
;MyHealtheVet combined output.
N PNAME,RIEN
S RIEN=DEFARR("IEN")
S PNAME=$O(^TMP("PXRHM",$J,RIEN,""))
S ^TMP("PXRMMHVC",$J,RIEN,"STATUS")=^TMP("PXRHM",$J,RIEN,PNAME)
D MHVD(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,0)
M ^TMP("PXRMMHVC",$J,RIEN,"DETAIL")=^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
K ^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
D MHVS(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,0)
M ^TMP("PXRMMHVC",$J,RIEN,"SUMMARY")=^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
K ^TMP("PXRHM",$J,RIEN,PNAME)
Q
;
;================================================
MHVD(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
;MyHealtheVet detailed output.
N IND,JND,FIDATA,FINDING,FLIST,FTYPE
N HDR,NHDR,IFIEVAL,LIST,NFLINES,NTXT,NUM
N TEXT
S NTXT=0
;Output the AGE match/no match text.
D AGE^PXRMFNFT(PXRMPDEM("DFN"),.DEFARR,.FIEVAL,.NTXT)
;Process the findings in the order: patient cohort, resolution,
;age, and informational.
M FIDATA=FIEVAL
F FTYPE="PCL","RES","AGE","INFO" D
. S LIST=$S(FTYPE="PCL":DEFARR(32),FTYPE="RES":DEFARR(36),FTYPE="AGE":DEFARR(40),FTYPE="INFO":DEFARR(42))
.;Output the general logic text.
. I FTYPE="PCL" D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,FTYPE,"D",.DEFARR,.NTXT)
. I FTYPE="RES",$P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,FTYPE,"D",.DEFARR,.NTXT)
.;Process the findings for each type.
. K TEXT
. S (NHDR,NFLINES)=0
. S NUM=+$P(LIST,U,1)
. S FLIST=$P(LIST,U,2)
. F IND=1:1:NUM D
.. S FINDING=$P(FLIST,";",IND)
..;No output for age or sex findings.
.. I (FINDING="AGE")!(FINDING="SEX") Q
..;Make sure each finding is processed only once.
.. I '$D(FIDATA(FINDING)) Q
.. K IFIEVAL
.. I FIEVAL(FINDING) D
... M IFIEVAL=FIEVAL(FINDING)
...;Remove any false occurrences so they are not displayed.
... S JND=0
... F S JND=+$O(IFIEVAL(JND)) Q:JND=0 K:'IFIEVAL(JND) IFIEVAL(JND)
.. E S IFIEVAL=0
..;Output the found/not found text for the finding.
.. D FINDING^PXRMFNFT(3,PXRMPDEM("DFN"),FINDING,.IFIEVAL,.NFLINES,.TEXT)
..;If the finding is true output the finding information.
.. I IFIEVAL D FOUT(1,.IFIEVAL,.NFLINES,.TEXT)
..;Make sure each finding is processed only once.
.. K FIDATA(FINDING)
.;
.;If there was any text for this finding type create a header.
.;Output the header and the finding text.
. D COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT)
I WEB D WEB(DEFARR("IEN"),.NTXT)
Q
;
;================================================
MHVS(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
;MyHealtheVet summary output.
N NTXT
S NTXT=0
D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,"PCL","S",.DEFARR,.NTXT)
I $P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,"RES","S",.DEFARR,.NTXT)
I WEB D WEB(DEFARR("IEN"),.NTXT)
Q
;
;================================================
WEB(RIEN,NTXT) ;Output the web site information.
N DES,IEN,IND,NL,TEXT,TITLE,URL
I '$D(^PXD(811.9,RIEN,50)) Q
S TEXT="\\ Please check these web sites for more information:\\"
D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
S IEN=0
F S IEN=+$O(^PXD(811.9,RIEN,50,IEN)) Q:IEN=0 D
. S TEXT=$G(^PXD(811.9,RIEN,50,IEN,0))
. S URL=$P(TEXT,U,1)
. I URL="" Q
. S TITLE=$P(TEXT,U,2)
. S DES=$D(^PXD(811.9,RIEN,50,IEN,1))
. S TEXT(1)="Web Site: "_TITLE_"\\"
. S TEXT(2)="URL: "_URL_$S('DES:"\\",1:"")
. D ADDTXTA^PXRMOUTU(2,PXRMRM,.NTXT,2,.TEXT)
.;If there is a description output it.
. I 'DES Q
. K TEXT
. S (IND,NL)=0
. F S IND=+$O(^PXD(811.9,RIEN,50,IEN,1,IND)) Q:IND=0 D
.. S NL=NL+1
.. S TEXT(NL)=^PXD(811.9,RIEN,50,IEN,1,IND,0)
. S TEXT(NL)=TEXT(NL)_"\\"
. D ADDTXTA^PXRMOUTU(3,PXRMRM,.NTXT,NL,.TEXT)
Q
;
PXRMOUTM ; SLC/PKR - MyHealtheVet output. ;23-Mar-2015 10:38;DU
+1 ;;2.0;CLINICAL REMINDERS;**4,6,1001,17,1005**;Feb 04, 2005;Build 23
+2 ;;IHS/MSC/MGH Added lines for non-VA files
+3 ;================================================
FOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Do output for individual findings
+1 ;in the FINDING array.
+2 IF $DATA(IFIEVAL("TERM"))
DO MHVOUT^PXRMTERM(1,.IFIEVAL,.NFLINES,.TEXT)
QUIT
+3 NEW FTYPE
+4 SET FTYPE=$PIECE(IFIEVAL("FINDING"),U,1)
+5 SET FTYPE=$PIECE(FTYPE,";",2)
+6 IF FTYPE="AUTTEDT("
DO MHVOUT^PXRMEDU(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+7 IF FTYPE="AUTTEXAM("
DO MHVOUT^PXRMEXAM(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+8 IF FTYPE="AUTTHF("
DO MHVOUT^PXRMHF(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+9 IF FTYPE="AUTTIMM("
DO MHVOUT^PXRMIMM(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+10 IF FTYPE="AUTTSK("
DO MHVOUT^PXRMSKIN(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+11 IF FTYPE="GMRD(120.51,"
DO MHVOUT^PXRMVITL(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+12 IF FTYPE="LAB(60,"
DO MHVOUT^PXRMLAB(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+13 IF FTYPE="ORD(101.43,"
DO MHVOUT^PXRMORDR(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+14 IF FTYPE="PS(50.605,"
DO MHVOUT^PXRMDRCL(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+15 IF FTYPE="PSDRUG("
DO MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+16 IF FTYPE="PS(55,"
DO MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+17 IF FTYPE="PS(55NVA,"
DO MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+18 IF FTYPE="PSRX("
DO MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+19 IF FTYPE="PSNDF(50.6,"
DO MHVOUT^PXRMDGEN(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+20 IF FTYPE="PXD(811.2,"
DO MHVOUT^PXRMTAX(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+21 IF FTYPE="PXRMD(802.4,"
DO MHVOUT^PXRMFF(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+22 IF FTYPE="PXRMD(810.9,"
DO MHVOUT^PXRMLOCF(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+23 IF FTYPE="PXRMD(811.4,"
DO MHVOUT^PXRMCF(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+24 IF FTYPE="RAMIS(71,"
DO MHVOUT^PXRMRAD(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+25 IF FTYPE="YTT(601.71,"
DO MHVOUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT)
QUIT
+26 ;IHS/MSC/MGH Output for IHS V files
+27 IF FTYPE="^AUTTMSR("
DO MHVOUT^BPXRMEA(INDENT,.IFIEVAL,.NLINE,.TEXT)
QUIT
+28 IF FTYPE="^AUTTREFT("
DO MHVOUT^BPXRMREF(INDENT,.IFIEVAL,.NLINE,.TEXT)
QUIT
+29 IF FTYPE="^APCDACV("
DO MHVOUT^BPXRMAS1(INDENT,.IFIEVAL,.NLINE,.TEXT)
QUIT
+30 QUIT
+31 ;
+32 ;================================================
MHVC(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL) ;Prepare the
+1 ;MyHealtheVet combined output.
+2 NEW PNAME,RIEN
+3 SET RIEN=DEFARR("IEN")
+4 SET PNAME=$ORDER(^TMP("PXRHM",$JOB,RIEN,""))
+5 SET ^TMP("PXRMMHVC",$JOB,RIEN,"STATUS")=^TMP("PXRHM",$JOB,RIEN,PNAME)
+6 DO MHVD(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,0)
+7 MERGE ^TMP("PXRMMHVC",$JOB,RIEN,"DETAIL")=^TMP("PXRHM",$JOB,RIEN,PNAME,"TXT")
+8 KILL ^TMP("PXRHM",$JOB,RIEN,PNAME,"TXT")
+9 DO MHVS(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,0)
+10 MERGE ^TMP("PXRMMHVC",$JOB,RIEN,"SUMMARY")=^TMP("PXRHM",$JOB,RIEN,PNAME,"TXT")
+11 KILL ^TMP("PXRHM",$JOB,RIEN,PNAME)
+12 QUIT
+13 ;
+14 ;================================================
MHVD(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
+1 ;MyHealtheVet detailed output.
+2 NEW IND,JND,FIDATA,FINDING,FLIST,FTYPE
+3 NEW HDR,NHDR,IFIEVAL,LIST,NFLINES,NTXT,NUM
+4 NEW TEXT
+5 SET NTXT=0
+6 ;Output the AGE match/no match text.
+7 DO AGE^PXRMFNFT(PXRMPDEM("DFN"),.DEFARR,.FIEVAL,.NTXT)
+8 ;Process the findings in the order: patient cohort, resolution,
+9 ;age, and informational.
+10 MERGE FIDATA=FIEVAL
+11 FOR FTYPE="PCL","RES","AGE","INFO"
Begin DoDot:1
+12 SET LIST=$SELECT(FTYPE="PCL":DEFARR(32),FTYPE="RES":DEFARR(36),FTYPE="AGE":DEFARR(40),FTYPE="INFO":DEFARR(42))
+13 ;Output the general logic text.
+14 IF FTYPE="PCL"
DO LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,FTYPE,"D",.DEFARR,.NTXT)
+15 IF FTYPE="RES"
IF $PIECE(PCLOGIC,U,1)
DO LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,FTYPE,"D",.DEFARR,.NTXT)
+16 ;Process the findings for each type.
+17 KILL TEXT
+18 SET (NHDR,NFLINES)=0
+19 SET NUM=+$PIECE(LIST,U,1)
+20 SET FLIST=$PIECE(LIST,U,2)
+21 FOR IND=1:1:NUM
Begin DoDot:2
+22 SET FINDING=$PIECE(FLIST,";",IND)
+23 ;No output for age or sex findings.
+24 IF (FINDING="AGE")!(FINDING="SEX")
QUIT
+25 ;Make sure each finding is processed only once.
+26 IF '$DATA(FIDATA(FINDING))
QUIT
+27 KILL IFIEVAL
+28 IF FIEVAL(FINDING)
Begin DoDot:3
+29 MERGE IFIEVAL=FIEVAL(FINDING)
+30 ;Remove any false occurrences so they are not displayed.
+31 SET JND=0
+32 FOR
SET JND=+$ORDER(IFIEVAL(JND))
IF JND=0
QUIT
IF 'IFIEVAL(JND)
KILL IFIEVAL(JND)
End DoDot:3
+33 IF '$TEST
SET IFIEVAL=0
+34 ;Output the found/not found text for the finding.
+35 DO FINDING^PXRMFNFT(3,PXRMPDEM("DFN"),FINDING,.IFIEVAL,.NFLINES,.TEXT)
+36 ;If the finding is true output the finding information.
+37 IF IFIEVAL
DO FOUT(1,.IFIEVAL,.NFLINES,.TEXT)
+38 ;Make sure each finding is processed only once.
+39 KILL FIDATA(FINDING)
End DoDot:2
+40 ;
+41 ;If there was any text for this finding type create a header.
+42 ;Output the header and the finding text.
+43 DO COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT)
End DoDot:1
+44 IF WEB
DO WEB(DEFARR("IEN"),.NTXT)
+45 QUIT
+46 ;
+47 ;================================================
MHVS(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
+1 ;MyHealtheVet summary output.
+2 NEW NTXT
+3 SET NTXT=0
+4 DO LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,"PCL","S",.DEFARR,.NTXT)
+5 IF $PIECE(PCLOGIC,U,1)
DO LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,"RES","S",.DEFARR,.NTXT)
+6 IF WEB
DO WEB(DEFARR("IEN"),.NTXT)
+7 QUIT
+8 ;
+9 ;================================================
WEB(RIEN,NTXT) ;Output the web site information.
+1 NEW DES,IEN,IND,NL,TEXT,TITLE,URL
+2 IF '$DATA(^PXD(811.9,RIEN,50))
QUIT
+3 SET TEXT="\\ Please check these web sites for more information:\\"
+4 DO ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
+5 SET IEN=0
+6 FOR
SET IEN=+$ORDER(^PXD(811.9,RIEN,50,IEN))
IF IEN=0
QUIT
Begin DoDot:1
+7 SET TEXT=$GET(^PXD(811.9,RIEN,50,IEN,0))
+8 SET URL=$PIECE(TEXT,U,1)
+9 IF URL=""
QUIT
+10 SET TITLE=$PIECE(TEXT,U,2)
+11 SET DES=$DATA(^PXD(811.9,RIEN,50,IEN,1))
+12 SET TEXT(1)="Web Site: "_TITLE_"\\"
+13 SET TEXT(2)="URL: "_URL_$SELECT('DES:"\\",1:"")
+14 DO ADDTXTA^PXRMOUTU(2,PXRMRM,.NTXT,2,.TEXT)
+15 ;If there is a description output it.
+16 IF 'DES
QUIT
+17 KILL TEXT
+18 SET (IND,NL)=0
+19 FOR
SET IND=+$ORDER(^PXD(811.9,RIEN,50,IEN,1,IND))
IF IND=0
QUIT
Begin DoDot:2
+20 SET NL=NL+1
+21 SET TEXT(NL)=^PXD(811.9,RIEN,50,IEN,1,IND,0)
End DoDot:2
+22 SET TEXT(NL)=TEXT(NL)_"\\"
+23 DO ADDTXTA^PXRMOUTU(3,PXRMRM,.NTXT,NL,.TEXT)
End DoDot:1
+24 QUIT
+25 ;
