PXRMRPCG ;SLC/RFR,AGP - PXRM REMINDER DIALOG GENERAL FINDING UPDATE;Nov 07, 2022@15:06:56
;;2.0;CLINICAL REMINDERS;**45,71,78,83**;Feb 04, 2005;Build 14
;DBIA USED
;2735 $$CTRL^XMXUTIL1
Q
BLDPARR(PROMPTS) ;
S PROMPTS("COM")=10
S PROMPTS("CPT_QTY")=5
S PROMPTS("DATE")=13
S PROMPTS("HF_LVL")=5
S PROMPTS("IMM_CNTR")=8
S PROMPTS("IMM_RCTN")=7
S PROMPTS("IMM_SER")=5
S PROMPTS("PED_LVL")=5
S PROMPTS("POV_ADD")=7
S PROMPTS("POV_PRIM")=5
S PROMPTS("SK_READ")=7
S PROMPTS("SK_RES")=5
S PROMPTS("VST_DATE")="VISIT STRING"
S PROMPTS("VST_LOC")="VISIT STRING"
S PROMPTS("WH_MAMMOGRAM_RESULTS")=11
S PROMPTS("WH_NOT_PURP")=12
S PROMPTS("WH_PAP_RESULTS")=11
S PROMPTS("XAM_RES")=5
S PROMPTS("pnumRemGenFindID")=14
S PROMPTS("pnumRemGenFindNewData")=16
S PROMPTS("pnumRemGenFindGroup")=17
S PROMPTS("GF_VIEW")=18
Q
;
CANCEL(RETURN) ;Reminder Dialog Cancel button RPC
N PXRMOUT
K ^TMP($J,"PXRM GEN FINDING"),^TMP($J,"PXRM DIALOG EVAL"),^TMP("WVGETORDERS",$J)
D OUSMALRT^ORBSMART(.PXRMOUT,"")
Q
;
GENFUPD(RETURN,DATA) ;General finding update RPC
N CNT,ERR,ERRDATA,PACKAGE,PKGDATA,PXRMOUT,SNDDATA,GROUP,LINE,RESULT,INDEX
D GENFORM(.DATA,.PKGDATA)
N $ES,$ET S $ET="D DERRHRLR^PXRMERRH"
S PACKAGE="" F S PACKAGE=$O(PKGDATA("DATA",PACKAGE)) Q:PACKAGE="" S GROUP="" F S GROUP=$O(PKGDATA("DATA",PACKAGE,GROUP)) Q:GROUP="" D
.S SNDDATA("DFN")=PKGDATA("DFN"),SNDDATA("VISIT")=$G(PKGDATA("VISIT")),SNDDATA("DOCUMENT")=PKGDATA("DOCUMENT")
.S SNDDATA("USER")=PKGDATA("USER"),SNDDATA("ENCOUNTER PROVIDER")=PKGDATA("ENCOUNTER PROVIDER")
.M SNDDATA("DATA")=PKGDATA("DATA",PACKAGE,GROUP)
.S CNT=1+$G(CNT)
.I PACKAGE="WOMEN'S HEALTH" D SAVEDATA^WVRPCPT(.RESULT,.SNDDATA)
.I PACKAGE="ORDER ENTRY/RESULTS REPORTING" D EN^ORBSMART(.RESULT,.SNDDATA)
.I PACKAGE="CLINICAL REMINDERS" S RESULT(1)=1
.I PACKAGE="REGISTRATION" D EN^PXRMDG(.RESULT,.SNDDATA)
.I $P($G(RESULT(1)),U)=-1 S PKGDATA("ERROR",PACKAGE,GROUP)=RESULT(1)
.I '$D(RESULT) S PKGDATA("ERROR",PACKAGE,GROUP)=0_U_"The package did not return a status."
.K SNDDATA,RESULT
D OUSMALRT^ORBSMART(.PXRMOUT,"")
K CNT
S LINE=0
I $D(PKGDATA("ERROR")) D
.S RETURN(0)=-1,PACKAGE=""
.I $G(PKGDATA("ERROR"))'="" S LINE=LINE+1,RETURN(LINE)=$P(PKGDATA("ERROR"),U,2)
.F S PACKAGE=$O(PKGDATA("ERROR",PACKAGE)) Q:PACKAGE="" S GROUP="" F S GROUP=$O(PKGDATA("ERROR",PACKAGE,GROUP)) Q:GROUP="" D
..I LINE>0 S LINE=LINE+1,RETURN(LINE)=""
..S LINE=LINE+1,RETURN(LINE)=PACKAGE_":"
..S LINE=LINE+1,RETURN(LINE)=$P(PKGDATA("ERROR",PACKAGE,GROUP),U,2)
..Q:$P(PKGDATA("ERROR",PACKAGE,GROUP),U)'=-1
..S ERRDATA("DFN")=PKGDATA("DFN"),ERRDATA("VISIT")=$G(PKGDATA("VISIT")),ERRDATA("GROUP")=GROUP,ERRDATA("DOCUMENT")=PKGDATA("DOCUMENT")
..M ERRDATA("DATA")=PKGDATA("DATA",PACKAGE,GROUP)
..K ^TMP("PXRMXMZ",$J) S CNT=0
..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="The following error occurred while saving general findings:"
..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$P(PKGDATA("ERROR",PACKAGE,GROUP),U,2)
..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="Please contact the help desk for assistance."
..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="See below for the data that was not saved:"
..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
..D ACOPY^PXRMUTIL("ERRDATA","ERR()")
..S INDEX=0 F S INDEX=$O(ERR(INDEX)) Q:INDEX'>0 S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=ERR(INDEX)
..D SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Error While Storing General Findings")
I '$D(PKGDATA("ERROR")) S RETURN(1)=1
Q
;
GENFORM(DATA,PKGDATA) ;
N GIEN,IDS,PIECE,PROMPT,PROMPTS,DIALOG,GROUP,INDEX,FINDINGS
N FILE,FIELD,VALUE,NDATA,PIEN,PSUB,PACKAGE
D BLDPARR(.PROMPTS)
S DIALOG="" F S DIALOG=$O(DATA(DIALOG)) Q:(DIALOG="")!($D(PKGDATA("ERROR"))) D
.I DIALOG=0 D Q
..S PKGDATA("DFN")=$P(DATA(DIALOG),U)
..;PASSING OF VISIT STRING DISABLED DUE TO CREATION DELAY OF SECONDARY VISIT FOR
..;INPATIENTS; REMOVE COMMENTS AROUND VISIT AFTER RELEASE OF PXRM*2*42
..;S PKGDATA("VISIT")=$P(DATA(DIALOG),U,2)
..S PKGDATA("DOCUMENT")=$P(DATA(DIALOG),U,3)
..S PKGDATA("USER")=$P(DATA(DIALOG),U,4)
..S PKGDATA("ENCOUNTER PROVIDER")=$P(DATA(DIALOG),U,5)
..;I '$P(PKGDATA("VISIT"),";") D Q
..;.S PKGDATA("ERROR")=-1_U_"Invalid visit selection"
.I $E(DIALOG,1)="R" S DIALOG(1)=$P($G(^PXD(811.9,$P(DIALOG,"R",2),51)),U)
.E S DIALOG(1)=DIALOG
.K INDEX
.S GROUP="" F S GROUP=$O(DATA(DIALOG,GROUP)) Q:(GROUP="")!($D(PKGDATA("ERROR"))) D
..S INDEX=0 F S INDEX=$O(DATA(DIALOG,GROUP,"ID",INDEX)) Q:'+INDEX D
...S GIEN=+$P(DATA(DIALOG,GROUP,"ID",INDEX),U)
...D GENFIND(.FINDINGS,GIEN) I ($D(FINDINGS("ERROR")))!('FINDINGS(GIEN,"CID")) Q
...S PKGDATA("DATA",FINDINGS(GIEN,"PACKAGE"),GROUP,FINDINGS(GIEN,"FILE"),"MASTER ID")=$P(DATA(DIALOG,GROUP,"ID",INDEX),U,2)
..S INDEX=0 F S INDEX=$O(DATA(DIALOG,GROUP,INDEX)) Q:'+INDEX D
...S GIEN=+$P(DATA(DIALOG,GROUP,INDEX),U,2)
...I '$D(FINDINGS(GIEN)) D GENFIND(.FINDINGS,GIEN) I $D(FINDINGS("ERROR")) Q
...S INDEX(GROUP,FINDINGS(GIEN,"FILE"),INDEX,"GIEN")=GIEN
.S GROUP="" F S GROUP=$O(INDEX(GROUP)) Q:GROUP="" K IDS S FILE=0 F S FILE=$O(INDEX(GROUP,FILE)) Q:'+FILE S INDEX=0 F S INDEX=$O(INDEX(GROUP,FILE,INDEX)) Q:'+INDEX D
..S GIEN=INDEX(GROUP,FILE,INDEX,"GIEN"),VALUE=FINDINGS(GIEN,"VALUE")
..S PIECE=PROMPTS("pnumRemGenFindNewData"),NDATA=+$P(DATA(DIALOG,GROUP,INDEX),U,PIECE)
..S PIEN=FINDINGS(GIEN,"PIEN"),PSUB=FINDINGS(GIEN,"PROMPT SUBSCRIPT"),PACKAGE=FINDINGS(GIEN,"PACKAGE")
..S FIELD=FINDINGS(GIEN,"FIELD")
..I NDATA D GETADDID(.IDS,FILE,FIELD)
..I 'NDATA D
...S PIECE=PROMPTS("pnumRemGenFindID"),IDS("ID")=$P(DATA(DIALOG,GROUP,INDEX),U,PIECE)
...I IDS("ID")="" S IDS("ID")=$G(PKGDATA("DATA",PACKAGE,GROUP,FILE,"MASTER ID"))
...I IDS("ID")="" D GETADDID(.IDS,FILE,FIELD)
..S:VALUE'="" PKGDATA("DATA",PACKAGE,GROUP,FILE,IDS("ID"),FIELD)=VALUE
..I +$G(PIEN)>0 D
...S PROMPT=$P($G(^PXRMD(801.42,PIEN,0)),U),PIECE=$G(PROMPTS(PROMPT)) I '+PIECE Q
...S FIELD=PSUB
...I FIELD'="" S PKGDATA("DATA",PACKAGE,GROUP,FILE,IDS("ID"),FIELD)=$$CTRL^XMXUTIL1($P(DATA(DIALOG,GROUP,INDEX),U,PIECE))
.K ^TMP($J,"PXRM GEN FINDING",DIALOG(1))
Q
;
GETADDID(IDS,FILE,FIELD) ;Return an add new entry ID
I (FIELD=.01)!(+$G(IDS("NEW",FILE))<1) S IDS("NEW",FILE)=1+$G(IDS("NEW",FILE))
S IDS("ID")="+"_IDS("NEW",FILE)_","
Q
;
GENFIND(FINDINGS,GIEN) ;Return general finding entry data
N X0,X1,X2,X3
S GIEN=+$G(GIEN)
I '((GIEN>0)&($D(^PXRMD(801.46,GIEN,0)))) S FINDINGS("ERROR")="ENTRY NOT FOUND" Q
S X0=$G(^PXRMD(801.46,GIEN,0)),X1=$G(^(1)),X2=$G(^(2)),X3=$G(^(3))
S FINDINGS(GIEN,"FILE")=$P(X0,U,3),FINDINGS(GIEN,"VALUE")=$P(X1,U),FINDINGS(GIEN,"FIELD")=$P(X1,U,2)
S FINDINGS(GIEN,"TYPE")=$P(X3,U),FINDINGS(GIEN,"CID")=+$P(X3,U,3),FINDINGS(GIEN,"PIEN")=$P(X2,U)
S FINDINGS(GIEN,"PROMPT SUBSCRIPT")=$P(X2,U,2)
I FINDINGS(GIEN,"FIELD")="" S FINDINGS(GIEN,"FIELD")=$P(X2,U,2)
S FINDINGS(GIEN,"PACKAGE")=$$GET1^DIQ(801.46,GIEN_",",2)
Q
;
GENFVALD(RETURN,DATA) ;General finding validate RPC
N PKGDATA,PACKAGE,SNDDATA,GROUP,RESULT,LINE,RLINE,CNT
N $ES,$ET S $ET="D DERRHRLR^PXRMERRH"
D GENFORM(.DATA,.PKGDATA)
S LINE=0,PACKAGE="" F S PACKAGE=$O(PKGDATA("DATA",PACKAGE)) Q:PACKAGE="" S GROUP="" F S GROUP=$O(PKGDATA("DATA",PACKAGE,GROUP)) Q:GROUP="" D
.S SNDDATA("DFN")=PKGDATA("DFN"),SNDDATA("VISIT")=$G(PKGDATA("VISIT")),SNDDATA("DOCUMENT")=PKGDATA("DOCUMENT")
.M SNDDATA("DATA")=PKGDATA("DATA",PACKAGE,GROUP)
.I PACKAGE="WOMEN'S HEALTH" D VERDATA^WVRPCPT2(.RESULT,.SNDDATA) S CNT=1+$G(CNT)
.I PACKAGE="REGISTRATION" D VERDATA^PXRMDG(.RESULT,.SNDDATA) S CNT=$G(CNT)+1
.;There are no other package validation APIs available, so don't report on their data
.I PACKAGE'="WOMEN'S HEALTH",PACKAGE'="REGISTRATION" S RESULT(0)=1
.I $G(RESULT(0))=-1 S RLINE=0 F S RLINE=$O(RESULT(RLINE)) Q:'+RLINE S LINE=LINE+1,PKGDATA("ERROR",PACKAGE,LINE)=RESULT(RLINE)
.I '$D(RESULT) S LINE=LINE+1,PKGDATA("ERROR",PACKAGE,LINE)="The package did not return a status."
.K SNDDATA,RESULT
I $D(PKGDATA("ERROR")) D
.I $G(PKGDATA("ERROR"))'="" S LINE=LINE+1,RETURN(LINE)=$P(PKGDATA("ERROR"),U,2)
.S LINE=0,RETURN(0)=-1,PACKAGE="" F S PACKAGE=$O(PKGDATA("ERROR",PACKAGE)) Q:PACKAGE="" D
..I LINE>0 S LINE=LINE+1,RETURN(LINE)=""
..S LINE=LINE+1,RETURN(LINE)=PACKAGE_":"
..S RLINE=0 F S RLINE=$O(PKGDATA("ERROR",PACKAGE,RLINE)) Q:'+RLINE S LINE=LINE+1,RETURN(LINE)=PKGDATA("ERROR",PACKAGE,RLINE)
I '$D(RETURN) S RETURN(0)=1
Q
;
GETFIND(RESULT,DFN,VISIT,NOTEIEN) ;
N CNT,FILE,FIELD,IDX,PKG,SUB,VALUE
S SUB="PXRM GF DATA",CNT=0
K ^TMP(SUB,$J)
D GETFINDS^WVRPCPT1(SUB,DFN,VISIT,NOTEIEN)
D GETFINDS^PXRMDG(SUB,DFN,VISIT,NOTEIEN)
I $G(^TMP(SUB,$J))<1 Q
S PKG="" F S PKG=$O(^TMP(SUB,$J,PKG)) Q:PKG="" D
.S FILE="" F S FILE=$O(^TMP(SUB,$J,PKG,FILE)) Q:FILE="" D
..S FIELD="" F S FIELD=$O(^TMP(SUB,$J,PKG,FILE,FIELD)) Q:FIELD="" D
...S VALUE=$G(^TMP(SUB,$J,PKG,FILE,FIELD))
...;check for multiple subscript
...I VALUE="" D Q
....S IDX=0 F S IDX=$O(^TMP(SUB,$J,PKG,FILE,FIELD,IDX)) Q:IDX'>0 D
.....S VALUE=$G(^TMP(SUB,$J,PKG,FILE,FIELD,IDX)) I VALUE="" Q
.....D GETFIND1(.RESULT,.CNT,PKG,FILE,FIELD,VALUE)
...D GETFIND1(.RESULT,.CNT,PKG,FILE,FIELD,VALUE)
Q
;
GETFIND1(RESULT,CNT,PKG,FILE,FIELD,VALUE) ;
N IEN,NODE,FOUND
I '$D(^PXRMD(801.46,"PFSV",PKG,FILE,FIELD,VALUE)),'$D(^PXRMD(801.46,"PFSP",PKG,FILE,FIELD)) Q
;check value xref
I $D(^PXRMD(801.46,"PFSV",PKG,FILE,FIELD,VALUE)) D Q
.S FOUND=0,IEN=0 F S IEN=$O(^PXRMD(801.46,"PFSV",PKG,FILE,FIELD,VALUE,IEN)) Q:IEN'>0!(FOUND=1) D
..I $P($G(^PXRMD(801.46,IEN,1)),U,3)=1 Q
..S NODE=$G(^PXRMD(801.46,IEN,0)),FOUND=1
..S CNT=CNT+1,RESULT(CNT)="GFIND"_U_IEN_U_U_$P(NODE,U)
;check prompt type xref
S FOUND=0,IEN=0 F S IEN=$O(^PXRMD(801.46,"PFSP",PKG,FILE,FIELD,IEN)) Q:IEN'>0!(FOUND=1) D
.I $P($G(^PXRMD(801.46,IEN,1)),U,3)=1 Q
.S NODE=$G(^PXRMD(801.46,IEN,0)),FOUND=1
.S CNT=CNT+1,RESULT(CNT)="GFIND"_U_IEN_U_U_$P(NODE,U)
Q
;
GETFINDS(DIEN,FINDINGS) ;
N CNT,FIND,PROMPT,TEMP
S FIND=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
S CNT=0
I FIND["PXRMD(801.46" D
.D GENFIND(.TEMP,+FIND) I $D(TEMP("ERROR")) Q
.S PROMPT=""
.I TEMP(+FIND,"PIEN")>0 S PROMPTYPE=$P($G(^PXRMD(801.42,TEMP(+FIND,"PIEN"),0)),U)
.S CNT=CNT+1
.S FINDINGS(TEMP(+FIND,"PACKAGE"),TEMP(+FIND,"FILE"),CNT)=TEMP(+FIND,"FIELD")_U_TEMP(+FIND,"VALUE")_U_TEMP(+FIND,"PIEN")_U_TEMP(+FIND,"PROMPT SUBSCRIPT")_U_PROMPT
S FIND="" F S FIND=$O(^PXRMD(801.41,DIEN,3,"B",FIND)) Q:FIND="" D
.K TEMP
.D GENFIND(.TEMP,+FIND) I $D(TEMP("ERROR")) Q
.S PROMPT=""
.I TEMP(+FIND,"PIEN")>0 S PROMPTYPE=$P($G(^PXRMD(801.42,TEMP(+FIND,"PIEN"),0)),U)
.S CNT=CNT+1
.S FINDINGS(TEMP(+FIND,"PACKAGE"),TEMP(+FIND,"FILE"),CNT)=TEMP(+FIND,"FIELD")_U_TEMP(+FIND,"VALUE")_U_TEMP(+FIND,"PIEN")_U_TEMP(+FIND,"PROMPT SUBSCRIPT")_U_PROMPT
Q
;
VIEW(RESULT,PAT,IEN,FINDVAL) ;
N FILE,FINDINGS,CNT,I,LST,NODE1,NODE2,PKG,PROMPTYPE,PXRMDIAG,SUB1,SUB2,TEXT,X,TCNT
;
S RESULT(0)=-1
D GETFINDS(IEN,.FINDINGS)
I $D(FINDINGS("WOMEN'S HEALTH")) D VIEWDATA^WVRPCGF1(.RESULT,.FINDINGS,PAT,FINDVAL)
I $D(FINDINGS("CLINICAL REMINDERS")) D VIEWDATA(.RESULT,.FINDINGS,PAT,IEN,FINDVAL)
Q
;
VIEWDATA(RESULT,DATA,PAT,DIEN,FINDVAL) ;
N CNT,INARRAY,INC,NIN,NOUT,NODE,OUTARRAY,PKG,PROMPT,PXRMRM,SUB,SUB1,VALUE
S PKG="CLINICAL REMINDERS"
;Cascade Index button
I $D(DATA(PKG,809)) D
.S INC=0 F S INC=$O(DATA(PKG,809,INC)) Q:INC'>0 D
..S NODE=$G(DATA(PKG,809,INC))
..S SUB=$P(NODE,U),VALUE=$P(NODE,U,2),SUB1=$P(NODE,U,4),PROMPT=$P(NODE,U,5)
..I SUB1="MOST RECENT EPISODE" D Q
...I $$OBJ^PXRMCEOC("PXRMRPCG REPORT",PAT,"BREAST CARE")
...S RESULT(0)=1_U_"Index mammogram and followup activities (Oldest to Most Recent)"
...S CNT=0,I=0 F S I=$O(^TMP("PXRMRPCG REPORT",$J,I)) Q:I'>0 D
....S CNT=CNT+1,RESULT(CNT)=$G(^TMP("PXRMRPCG REPORT",$J,I,0))
;Dialog Alternative Progress note text
I $D(DATA(PKG,801.41)) D
.S INC=0 F S INC=$O(DATA(PKG,801.41,INC)) Q:INC'>0 D
..S NODE=$G(DATA(PKG,801.41,INC))
..S SUB=$P(NODE,U),VALUE=$P(NODE,U,2),SUB1=$P(NODE,U,4),PROMPT=$P(NODE,U,5)
..I SUB1="VIEW PROGRESS NOTE TEXT" D
...;S CNT=0,NIN=0 F S CNT=$O(^PXRMD(801.41,DIEN,35,CNT)) Q:CNT'>0 D
...;.S NIN=NIN+1,INARRAY(NIN)=^PXRMD(801.41,DIEN,35,CNT,0)
...;(INDENT,NIN,TEXTIN,DFN,VSTR,NLINES,TEXT)
...S NIN=0
...D TIUSRCH(DIEN,.NIN,.INARRAY)
...S PXRMRM=80,NOUT=0
...D FNFTXTO^PXRMFNFT(1,.NIN,.INARRAY,PAT,"",.NOUT,.OUTARRAY)
...;D FORMAT^PXRMTEXT(0,80,NIN,.INARRAY,.NOUT,.OUTARRAY)
...F CNT=1:1:NOUT S RESULT(CNT)=OUTARRAY(CNT)
..S RESULT(0)=1_U_$P(^PXRMD(801.41,DIEN,0),U)
Q
;
FNDWDATA(RESULT,PAT,IEN,FINDVAL,EPNAME) ;
N CNT,DTE,IEN,INC,LDATE,NODE,TEXT,WVIEN,TCNT
S DTE=$O(^PXRM(809,"C",PAT,EPNAME,""),-1) Q:DTE'>0
S IEN=$O(^PXRM(809,"C",PAT,EPNAME,DTE,"")) Q:IEN'>0
S CNT=0
S INC=0
F S INC=$O(^PXRM(809,IEN,1,INC)) Q:INC'>0 D
.S NODE=$G(^PXRM(809,IEN,1,INC,0))
.I $P(NODE,U)'["WV(790.1" Q
.S WVIEN=+$P(NODE,U)
.I $$NOOPEN^PXRMCWH(WVIEN,PAT,0,0) Q
.;D GETTEST(WVIEN,.CNT,.RESULT)
.S TCNT=0,LDATE=$P(NODE,U,5)
.D GETWVP^PXRMCEOC(PAT,$P(NODE,U),$P(NODE,U,2),LDATE,1,.TEXT,.TCNT)
.S TCNT=0 F S TCNT=$O(TEXT(1,TCNT)) Q:TCNT'>0 S CNT=CNT+1,RESULT(CNT)=TEXT(1,TCNT)
.S CNT=CNT+1,RESULT(CNT)=""
Q
;
TIUSRCH(IEN,NIN,ARRAY) ;
N CNT,INPUTS,OLIST,ONAME,TEXT,TLIST,TMP
D TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,35,.OLIST,.TLIST)
S CNT=0 F S CNT=$O(OLIST(CNT)) Q:CNT'>0 D
.S ONAME=OLIST(CNT)
.S INPUTS("|"_ONAME_"|")="'FMT{|"_ONAME_"|}FMT"
;
S CNT=0
F S CNT=$O(^PXRMD(801.41,DIEN,35,CNT)) Q:CNT'>0 D
.S TMP=^PXRMD(801.41,DIEN,35,CNT,0)
.S TEXT=$$REPLACE^XLFSTR(TMP,.INPUTS)
.S NIN=NIN+1,ARRAY(NIN)=TEXT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRPCG 13790 printed Apr 09, 2024@20:52:38 Page 2
PXRMRPCG ;SLC/RFR,AGP - PXRM REMINDER DIALOG GENERAL FINDING UPDATE;Nov 07, 2022@15:06:56
+1 ;;2.0;CLINICAL REMINDERS;**45,71,78,83**;Feb 04, 2005;Build 14
+2 ;DBIA USED
+3 ;2735 $$CTRL^XMXUTIL1
+4 QUIT
BLDPARR(PROMPTS) ;
+1 SET PROMPTS("COM")=10
+2 SET PROMPTS("CPT_QTY")=5
+3 SET PROMPTS("DATE")=13
+4 SET PROMPTS("HF_LVL")=5
+5 SET PROMPTS("IMM_CNTR")=8
+6 SET PROMPTS("IMM_RCTN")=7
+7 SET PROMPTS("IMM_SER")=5
+8 SET PROMPTS("PED_LVL")=5
+9 SET PROMPTS("POV_ADD")=7
+10 SET PROMPTS("POV_PRIM")=5
+11 SET PROMPTS("SK_READ")=7
+12 SET PROMPTS("SK_RES")=5
+13 SET PROMPTS("VST_DATE")="VISIT STRING"
+14 SET PROMPTS("VST_LOC")="VISIT STRING"
+15 SET PROMPTS("WH_MAMMOGRAM_RESULTS")=11
+16 SET PROMPTS("WH_NOT_PURP")=12
+17 SET PROMPTS("WH_PAP_RESULTS")=11
+18 SET PROMPTS("XAM_RES")=5
+19 SET PROMPTS("pnumRemGenFindID")=14
+20 SET PROMPTS("pnumRemGenFindNewData")=16
+21 SET PROMPTS("pnumRemGenFindGroup")=17
+22 SET PROMPTS("GF_VIEW")=18
+23 QUIT
+24 ;
CANCEL(RETURN) ;Reminder Dialog Cancel button RPC
+1 NEW PXRMOUT
+2 KILL ^TMP($JOB,"PXRM GEN FINDING"),^TMP($JOB,"PXRM DIALOG EVAL"),^TMP("WVGETORDERS",$JOB)
+3 DO OUSMALRT^ORBSMART(.PXRMOUT,"")
+4 QUIT
+5 ;
GENFUPD(RETURN,DATA) ;General finding update RPC
+1 NEW CNT,ERR,ERRDATA,PACKAGE,PKGDATA,PXRMOUT,SNDDATA,GROUP,LINE,RESULT,INDEX
+2 DO GENFORM(.DATA,.PKGDATA)
+3 NEW $ESTACK,$ETRAP
SET $ETRAP="D DERRHRLR^PXRMERRH"
+4 SET PACKAGE=""
FOR
SET PACKAGE=$ORDER(PKGDATA("DATA",PACKAGE))
if PACKAGE=""
QUIT
SET GROUP=""
FOR
SET GROUP=$ORDER(PKGDATA("DATA",PACKAGE,GROUP))
if GROUP=""
QUIT
Begin DoDot:1
+5 SET SNDDATA("DFN")=PKGDATA("DFN")
SET SNDDATA("VISIT")=$GET(PKGDATA("VISIT"))
SET SNDDATA("DOCUMENT")=PKGDATA("DOCUMENT")
+6 SET SNDDATA("USER")=PKGDATA("USER")
SET SNDDATA("ENCOUNTER PROVIDER")=PKGDATA("ENCOUNTER PROVIDER")
+7 MERGE SNDDATA("DATA")=PKGDATA("DATA",PACKAGE,GROUP)
+8 SET CNT=1+$GET(CNT)
+9 IF PACKAGE="WOMEN'S HEALTH"
DO SAVEDATA^WVRPCPT(.RESULT,.SNDDATA)
+10 IF PACKAGE="ORDER ENTRY/RESULTS REPORTING"
DO EN^ORBSMART(.RESULT,.SNDDATA)
+11 IF PACKAGE="CLINICAL REMINDERS"
SET RESULT(1)=1
+12 IF PACKAGE="REGISTRATION"
DO EN^PXRMDG(.RESULT,.SNDDATA)
+13 IF $PIECE($GET(RESULT(1)),U)=-1
SET PKGDATA("ERROR",PACKAGE,GROUP)=RESULT(1)
+14 IF '$DATA(RESULT)
SET PKGDATA("ERROR",PACKAGE,GROUP)=0_U_"The package did not return a status."
+15 KILL SNDDATA,RESULT
End DoDot:1
+16 DO OUSMALRT^ORBSMART(.PXRMOUT,"")
+17 KILL CNT
+18 SET LINE=0
+19 IF $DATA(PKGDATA("ERROR"))
Begin DoDot:1
+20 SET RETURN(0)=-1
SET PACKAGE=""
+21 IF $GET(PKGDATA("ERROR"))'=""
SET LINE=LINE+1
SET RETURN(LINE)=$PIECE(PKGDATA("ERROR"),U,2)
+22 FOR
SET PACKAGE=$ORDER(PKGDATA("ERROR",PACKAGE))
if PACKAGE=""
QUIT
SET GROUP=""
FOR
SET GROUP=$ORDER(PKGDATA("ERROR",PACKAGE,GROUP))
if GROUP=""
QUIT
Begin DoDot:2
+23 IF LINE>0
SET LINE=LINE+1
SET RETURN(LINE)=""
+24 SET LINE=LINE+1
SET RETURN(LINE)=PACKAGE_":"
+25 SET LINE=LINE+1
SET RETURN(LINE)=$PIECE(PKGDATA("ERROR",PACKAGE,GROUP),U,2)
+26 if $PIECE(PKGDATA("ERROR",PACKAGE,GROUP),U)'=-1
QUIT
+27 SET ERRDATA("DFN")=PKGDATA("DFN")
SET ERRDATA("VISIT")=$GET(PKGDATA("VISIT"))
SET ERRDATA("GROUP")=GROUP
SET ERRDATA("DOCUMENT")=PKGDATA("DOCUMENT")
+28 MERGE ERRDATA("DATA")=PKGDATA("DATA",PACKAGE,GROUP)
+29 KILL ^TMP("PXRMXMZ",$JOB)
SET CNT=0
+30 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="The following error occurred while saving general findings:"
+31 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$PIECE(PKGDATA("ERROR",PACKAGE,GROUP),U,2)
+32 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="Please contact the help desk for assistance."
+33 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+34 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="See below for the data that was not saved:"
+35 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+36 DO ACOPY^PXRMUTIL("ERRDATA","ERR()")
+37 SET INDEX=0
FOR
SET INDEX=$ORDER(ERR(INDEX))
if INDEX'>0
QUIT
SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=ERR(INDEX)
+38 DO SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Error While Storing General Findings")
End DoDot:2
End DoDot:1
+39 IF '$DATA(PKGDATA("ERROR"))
SET RETURN(1)=1
+40 QUIT
+41 ;
GENFORM(DATA,PKGDATA) ;
+1 NEW GIEN,IDS,PIECE,PROMPT,PROMPTS,DIALOG,GROUP,INDEX,FINDINGS
+2 NEW FILE,FIELD,VALUE,NDATA,PIEN,PSUB,PACKAGE
+3 DO BLDPARR(.PROMPTS)
+4 SET DIALOG=""
FOR
SET DIALOG=$ORDER(DATA(DIALOG))
if (DIALOG="")!($DATA(PKGDATA("ERROR")))
QUIT
Begin DoDot:1
+5 IF DIALOG=0
Begin DoDot:2
+6 SET PKGDATA("DFN")=$PIECE(DATA(DIALOG),U)
+7 ;PASSING OF VISIT STRING DISABLED DUE TO CREATION DELAY OF SECONDARY VISIT FOR
+8 ;INPATIENTS; REMOVE COMMENTS AROUND VISIT AFTER RELEASE OF PXRM*2*42
+9 ;S PKGDATA("VISIT")=$P(DATA(DIALOG),U,2)
+10 SET PKGDATA("DOCUMENT")=$PIECE(DATA(DIALOG),U,3)
+11 SET PKGDATA("USER")=$PIECE(DATA(DIALOG),U,4)
+12 SET PKGDATA("ENCOUNTER PROVIDER")=$PIECE(DATA(DIALOG),U,5)
+13 ;I '$P(PKGDATA("VISIT"),";") D Q
+14 ;.S PKGDATA("ERROR")=-1_U_"Invalid visit selection"
End DoDot:2
QUIT
+15 IF $EXTRACT(DIALOG,1)="R"
SET DIALOG(1)=$PIECE($GET(^PXD(811.9,$PIECE(DIALOG,"R",2),51)),U)
+16 IF '$TEST
SET DIALOG(1)=DIALOG
+17 KILL INDEX
+18 SET GROUP=""
FOR
SET GROUP=$ORDER(DATA(DIALOG,GROUP))
if (GROUP="")!($DATA(PKGDATA("ERROR")))
QUIT
Begin DoDot:2
+19 SET INDEX=0
FOR
SET INDEX=$ORDER(DATA(DIALOG,GROUP,"ID",INDEX))
if '+INDEX
QUIT
Begin DoDot:3
+20 SET GIEN=+$PIECE(DATA(DIALOG,GROUP,"ID",INDEX),U)
+21 DO GENFIND(.FINDINGS,GIEN)
IF ($DATA(FINDINGS("ERROR")))!('FINDINGS(GIEN,"CID"))
QUIT
+22 SET PKGDATA("DATA",FINDINGS(GIEN,"PACKAGE"),GROUP,FINDINGS(GIEN,"FILE"),"MASTER ID")=$PIECE(DATA(DIALOG,GROUP,"ID",INDEX),U,2)
End DoDot:3
+23 SET INDEX=0
FOR
SET INDEX=$ORDER(DATA(DIALOG,GROUP,INDEX))
if '+INDEX
QUIT
Begin DoDot:3
+24 SET GIEN=+$PIECE(DATA(DIALOG,GROUP,INDEX),U,2)
+25 IF '$DATA(FINDINGS(GIEN))
DO GENFIND(.FINDINGS,GIEN)
IF $DATA(FINDINGS("ERROR"))
QUIT
+26 SET INDEX(GROUP,FINDINGS(GIEN,"FILE"),INDEX,"GIEN")=GIEN
End DoDot:3
End DoDot:2
+27 SET GROUP=""
FOR
SET GROUP=$ORDER(INDEX(GROUP))
if GROUP=""
QUIT
KILL IDS
SET FILE=0
FOR
SET FILE=$ORDER(INDEX(GROUP,FILE))
if '+FILE
QUIT
SET INDEX=0
FOR
SET INDEX=$ORDER(INDEX(GROUP,FILE,INDEX))
if '+INDEX
QUIT
Begin DoDot:2
+28 SET GIEN=INDEX(GROUP,FILE,INDEX,"GIEN")
SET VALUE=FINDINGS(GIEN,"VALUE")
+29 SET PIECE=PROMPTS("pnumRemGenFindNewData")
SET NDATA=+$PIECE(DATA(DIALOG,GROUP,INDEX),U,PIECE)
+30 SET PIEN=FINDINGS(GIEN,"PIEN")
SET PSUB=FINDINGS(GIEN,"PROMPT SUBSCRIPT")
SET PACKAGE=FINDINGS(GIEN,"PACKAGE")
+31 SET FIELD=FINDINGS(GIEN,"FIELD")
+32 IF NDATA
DO GETADDID(.IDS,FILE,FIELD)
+33 IF 'NDATA
Begin DoDot:3
+34 SET PIECE=PROMPTS("pnumRemGenFindID")
SET IDS("ID")=$PIECE(DATA(DIALOG,GROUP,INDEX),U,PIECE)
+35 IF IDS("ID")=""
SET IDS("ID")=$GET(PKGDATA("DATA",PACKAGE,GROUP,FILE,"MASTER ID"))
+36 IF IDS("ID")=""
DO GETADDID(.IDS,FILE,FIELD)
End DoDot:3
+37 if VALUE'=""
SET PKGDATA("DATA",PACKAGE,GROUP,FILE,IDS("ID"),FIELD)=VALUE
+38 IF +$GET(PIEN)>0
Begin DoDot:3
+39 SET PROMPT=$PIECE($GET(^PXRMD(801.42,PIEN,0)),U)
SET PIECE=$GET(PROMPTS(PROMPT))
IF '+PIECE
QUIT
+40 SET FIELD=PSUB
+41 IF FIELD'=""
SET PKGDATA("DATA",PACKAGE,GROUP,FILE,IDS("ID"),FIELD)=$$CTRL^XMXUTIL1($PIECE(DATA(DIALOG,GROUP,INDEX),U,PIECE))
End DoDot:3
End DoDot:2
+42 KILL ^TMP($JOB,"PXRM GEN FINDING",DIALOG(1))
End DoDot:1
+43 QUIT
+44 ;
GETADDID(IDS,FILE,FIELD) ;Return an add new entry ID
+1 IF (FIELD=.01)!(+$GET(IDS("NEW",FILE))<1)
SET IDS("NEW",FILE)=1+$GET(IDS("NEW",FILE))
+2 SET IDS("ID")="+"_IDS("NEW",FILE)_","
+3 QUIT
+4 ;
GENFIND(FINDINGS,GIEN) ;Return general finding entry data
+1 NEW X0,X1,X2,X3
+2 SET GIEN=+$GET(GIEN)
+3 IF '((GIEN>0)&($DATA(^PXRMD(801.46,GIEN,0))))
SET FINDINGS("ERROR")="ENTRY NOT FOUND"
QUIT
+4 SET X0=$GET(^PXRMD(801.46,GIEN,0))
SET X1=$GET(^(1))
SET X2=$GET(^(2))
SET X3=$GET(^(3))
+5 SET FINDINGS(GIEN,"FILE")=$PIECE(X0,U,3)
SET FINDINGS(GIEN,"VALUE")=$PIECE(X1,U)
SET FINDINGS(GIEN,"FIELD")=$PIECE(X1,U,2)
+6 SET FINDINGS(GIEN,"TYPE")=$PIECE(X3,U)
SET FINDINGS(GIEN,"CID")=+$PIECE(X3,U,3)
SET FINDINGS(GIEN,"PIEN")=$PIECE(X2,U)
+7 SET FINDINGS(GIEN,"PROMPT SUBSCRIPT")=$PIECE(X2,U,2)
+8 IF FINDINGS(GIEN,"FIELD")=""
SET FINDINGS(GIEN,"FIELD")=$PIECE(X2,U,2)
+9 SET FINDINGS(GIEN,"PACKAGE")=$$GET1^DIQ(801.46,GIEN_",",2)
+10 QUIT
+11 ;
GENFVALD(RETURN,DATA) ;General finding validate RPC
+1 NEW PKGDATA,PACKAGE,SNDDATA,GROUP,RESULT,LINE,RLINE,CNT
+2 NEW $ESTACK,$ETRAP
SET $ETRAP="D DERRHRLR^PXRMERRH"
+3 DO GENFORM(.DATA,.PKGDATA)
+4 SET LINE=0
SET PACKAGE=""
FOR
SET PACKAGE=$ORDER(PKGDATA("DATA",PACKAGE))
if PACKAGE=""
QUIT
SET GROUP=""
FOR
SET GROUP=$ORDER(PKGDATA("DATA",PACKAGE,GROUP))
if GROUP=""
QUIT
Begin DoDot:1
+5 SET SNDDATA("DFN")=PKGDATA("DFN")
SET SNDDATA("VISIT")=$GET(PKGDATA("VISIT"))
SET SNDDATA("DOCUMENT")=PKGDATA("DOCUMENT")
+6 MERGE SNDDATA("DATA")=PKGDATA("DATA",PACKAGE,GROUP)
+7 IF PACKAGE="WOMEN'S HEALTH"
DO VERDATA^WVRPCPT2(.RESULT,.SNDDATA)
SET CNT=1+$GET(CNT)
+8 IF PACKAGE="REGISTRATION"
DO VERDATA^PXRMDG(.RESULT,.SNDDATA)
SET CNT=$GET(CNT)+1
+9 ;There are no other package validation APIs available, so don't report on their data
+10 IF PACKAGE'="WOMEN'S HEALTH"
IF PACKAGE'="REGISTRATION"
SET RESULT(0)=1
+11 IF $GET(RESULT(0))=-1
SET RLINE=0
FOR
SET RLINE=$ORDER(RESULT(RLINE))
if '+RLINE
QUIT
SET LINE=LINE+1
SET PKGDATA("ERROR",PACKAGE,LINE)=RESULT(RLINE)
+12 IF '$DATA(RESULT)
SET LINE=LINE+1
SET PKGDATA("ERROR",PACKAGE,LINE)="The package did not return a status."
+13 KILL SNDDATA,RESULT
End DoDot:1
+14 IF $DATA(PKGDATA("ERROR"))
Begin DoDot:1
+15 IF $GET(PKGDATA("ERROR"))'=""
SET LINE=LINE+1
SET RETURN(LINE)=$PIECE(PKGDATA("ERROR"),U,2)
+16 SET LINE=0
SET RETURN(0)=-1
SET PACKAGE=""
FOR
SET PACKAGE=$ORDER(PKGDATA("ERROR",PACKAGE))
if PACKAGE=""
QUIT
Begin DoDot:2
+17 IF LINE>0
SET LINE=LINE+1
SET RETURN(LINE)=""
+18 SET LINE=LINE+1
SET RETURN(LINE)=PACKAGE_":"
+19 SET RLINE=0
FOR
SET RLINE=$ORDER(PKGDATA("ERROR",PACKAGE,RLINE))
if '+RLINE
QUIT
SET LINE=LINE+1
SET RETURN(LINE)=PKGDATA("ERROR",PACKAGE,RLINE)
End DoDot:2
End DoDot:1
+20 IF '$DATA(RETURN)
SET RETURN(0)=1
+21 QUIT
+22 ;
GETFIND(RESULT,DFN,VISIT,NOTEIEN) ;
+1 NEW CNT,FILE,FIELD,IDX,PKG,SUB,VALUE
+2 SET SUB="PXRM GF DATA"
SET CNT=0
+3 KILL ^TMP(SUB,$JOB)
+4 DO GETFINDS^WVRPCPT1(SUB,DFN,VISIT,NOTEIEN)
+5 DO GETFINDS^PXRMDG(SUB,DFN,VISIT,NOTEIEN)
+6 IF $GET(^TMP(SUB,$JOB))<1
QUIT
+7 SET PKG=""
FOR
SET PKG=$ORDER(^TMP(SUB,$JOB,PKG))
if PKG=""
QUIT
Begin DoDot:1
+8 SET FILE=""
FOR
SET FILE=$ORDER(^TMP(SUB,$JOB,PKG,FILE))
if FILE=""
QUIT
Begin DoDot:2
+9 SET FIELD=""
FOR
SET FIELD=$ORDER(^TMP(SUB,$JOB,PKG,FILE,FIELD))
if FIELD=""
QUIT
Begin DoDot:3
+10 SET VALUE=$GET(^TMP(SUB,$JOB,PKG,FILE,FIELD))
+11 ;check for multiple subscript
+12 IF VALUE=""
Begin DoDot:4
+13 SET IDX=0
FOR
SET IDX=$ORDER(^TMP(SUB,$JOB,PKG,FILE,FIELD,IDX))
if IDX'>0
QUIT
Begin DoDot:5
+14 SET VALUE=$GET(^TMP(SUB,$JOB,PKG,FILE,FIELD,IDX))
IF VALUE=""
QUIT
+15 DO GETFIND1(.RESULT,.CNT,PKG,FILE,FIELD,VALUE)
End DoDot:5
End DoDot:4
QUIT
+16 DO GETFIND1(.RESULT,.CNT,PKG,FILE,FIELD,VALUE)
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
GETFIND1(RESULT,CNT,PKG,FILE,FIELD,VALUE) ;
+1 NEW IEN,NODE,FOUND
+2 IF '$DATA(^PXRMD(801.46,"PFSV",PKG,FILE,FIELD,VALUE))
IF '$DATA(^PXRMD(801.46,"PFSP",PKG,FILE,FIELD))
QUIT
+3 ;check value xref
+4 IF $DATA(^PXRMD(801.46,"PFSV",PKG,FILE,FIELD,VALUE))
Begin DoDot:1
+5 SET FOUND=0
SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.46,"PFSV",PKG,FILE,FIELD,VALUE,IEN))
if IEN'>0!(FOUND=1)
QUIT
Begin DoDot:2
+6 IF $PIECE($GET(^PXRMD(801.46,IEN,1)),U,3)=1
QUIT
+7 SET NODE=$GET(^PXRMD(801.46,IEN,0))
SET FOUND=1
+8 SET CNT=CNT+1
SET RESULT(CNT)="GFIND"_U_IEN_U_U_$PIECE(NODE,U)
End DoDot:2
End DoDot:1
QUIT
+9 ;check prompt type xref
+10 SET FOUND=0
SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.46,"PFSP",PKG,FILE,FIELD,IEN))
if IEN'>0!(FOUND=1)
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^PXRMD(801.46,IEN,1)),U,3)=1
QUIT
+12 SET NODE=$GET(^PXRMD(801.46,IEN,0))
SET FOUND=1
+13 SET CNT=CNT+1
SET RESULT(CNT)="GFIND"_U_IEN_U_U_$PIECE(NODE,U)
End DoDot:1
+14 QUIT
+15 ;
GETFINDS(DIEN,FINDINGS) ;
+1 NEW CNT,FIND,PROMPT,TEMP
+2 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
+3 SET CNT=0
+4 IF FIND["PXRMD(801.46"
Begin DoDot:1
+5 DO GENFIND(.TEMP,+FIND)
IF $DATA(TEMP("ERROR"))
QUIT
+6 SET PROMPT=""
+7 IF TEMP(+FIND,"PIEN")>0
SET PROMPTYPE=$PIECE($GET(^PXRMD(801.42,TEMP(+FIND,"PIEN"),0)),U)
+8 SET CNT=CNT+1
+9 SET FINDINGS(TEMP(+FIND,"PACKAGE"),TEMP(+FIND,"FILE"),CNT)=TEMP(+FIND,"FIELD")_U_TEMP(+FIND,"VALUE")_U_TEMP(+FIND,"PIEN")_U_TEMP(+FIND,"PROMPT SUBSCRIPT")_U_PROMPT
End DoDot:1
+10 SET FIND=""
FOR
SET FIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",FIND))
if FIND=""
QUIT
Begin DoDot:1
+11 KILL TEMP
+12 DO GENFIND(.TEMP,+FIND)
IF $DATA(TEMP("ERROR"))
QUIT
+13 SET PROMPT=""
+14 IF TEMP(+FIND,"PIEN")>0
SET PROMPTYPE=$PIECE($GET(^PXRMD(801.42,TEMP(+FIND,"PIEN"),0)),U)
+15 SET CNT=CNT+1
+16 SET FINDINGS(TEMP(+FIND,"PACKAGE"),TEMP(+FIND,"FILE"),CNT)=TEMP(+FIND,"FIELD")_U_TEMP(+FIND,"VALUE")_U_TEMP(+FIND,"PIEN")_U_TEMP(+FIND,"PROMPT SUBSCRIPT")_U_PROMPT
End DoDot:1
+17 QUIT
+18 ;
VIEW(RESULT,PAT,IEN,FINDVAL) ;
+1 NEW FILE,FINDINGS,CNT,I,LST,NODE1,NODE2,PKG,PROMPTYPE,PXRMDIAG,SUB1,SUB2,TEXT,X,TCNT
+2 ;
+3 SET RESULT(0)=-1
+4 DO GETFINDS(IEN,.FINDINGS)
+5 IF $DATA(FINDINGS("WOMEN'S HEALTH"))
DO VIEWDATA^WVRPCGF1(.RESULT,.FINDINGS,PAT,FINDVAL)
+6 IF $DATA(FINDINGS("CLINICAL REMINDERS"))
DO VIEWDATA(.RESULT,.FINDINGS,PAT,IEN,FINDVAL)
+7 QUIT
+8 ;
VIEWDATA(RESULT,DATA,PAT,DIEN,FINDVAL) ;
+1 NEW CNT,INARRAY,INC,NIN,NOUT,NODE,OUTARRAY,PKG,PROMPT,PXRMRM,SUB,SUB1,VALUE
+2 SET PKG="CLINICAL REMINDERS"
+3 ;Cascade Index button
+4 IF $DATA(DATA(PKG,809))
Begin DoDot:1
+5 SET INC=0
FOR
SET INC=$ORDER(DATA(PKG,809,INC))
if INC'>0
QUIT
Begin DoDot:2
+6 SET NODE=$GET(DATA(PKG,809,INC))
+7 SET SUB=$PIECE(NODE,U)
SET VALUE=$PIECE(NODE,U,2)
SET SUB1=$PIECE(NODE,U,4)
SET PROMPT=$PIECE(NODE,U,5)
+8 IF SUB1="MOST RECENT EPISODE"
Begin DoDot:3
+9 IF $$OBJ^PXRMCEOC("PXRMRPCG REPORT",PAT,"BREAST CARE")
+10 SET RESULT(0)=1_U_"Index mammogram and followup activities (Oldest to Most Recent)"
+11 SET CNT=0
SET I=0
FOR
SET I=$ORDER(^TMP("PXRMRPCG REPORT",$JOB,I))
if I'>0
QUIT
Begin DoDot:4
+12 SET CNT=CNT+1
SET RESULT(CNT)=$GET(^TMP("PXRMRPCG REPORT",$JOB,I,0))
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+13 ;Dialog Alternative Progress note text
+14 IF $DATA(DATA(PKG,801.41))
Begin DoDot:1
+15 SET INC=0
FOR
SET INC=$ORDER(DATA(PKG,801.41,INC))
if INC'>0
QUIT
Begin DoDot:2
+16 SET NODE=$GET(DATA(PKG,801.41,INC))
+17 SET SUB=$PIECE(NODE,U)
SET VALUE=$PIECE(NODE,U,2)
SET SUB1=$PIECE(NODE,U,4)
SET PROMPT=$PIECE(NODE,U,5)
+18 IF SUB1="VIEW PROGRESS NOTE TEXT"
Begin DoDot:3
+19 ;S CNT=0,NIN=0 F S CNT=$O(^PXRMD(801.41,DIEN,35,CNT)) Q:CNT'>0 D
+20 ;.S NIN=NIN+1,INARRAY(NIN)=^PXRMD(801.41,DIEN,35,CNT,0)
+21 ;(INDENT,NIN,TEXTIN,DFN,VSTR,NLINES,TEXT)
+22 SET NIN=0
+23 DO TIUSRCH(DIEN,.NIN,.INARRAY)
+24 SET PXRMRM=80
SET NOUT=0
+25 DO FNFTXTO^PXRMFNFT(1,.NIN,.INARRAY,PAT,"",.NOUT,.OUTARRAY)
+26 ;D FORMAT^PXRMTEXT(0,80,NIN,.INARRAY,.NOUT,.OUTARRAY)
+27 FOR CNT=1:1:NOUT
SET RESULT(CNT)=OUTARRAY(CNT)
End DoDot:3
+28 SET RESULT(0)=1_U_$PIECE(^PXRMD(801.41,DIEN,0),U)
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
FNDWDATA(RESULT,PAT,IEN,FINDVAL,EPNAME) ;
+1 NEW CNT,DTE,IEN,INC,LDATE,NODE,TEXT,WVIEN,TCNT
+2 SET DTE=$ORDER(^PXRM(809,"C",PAT,EPNAME,""),-1)
if DTE'>0
QUIT
+3 SET IEN=$ORDER(^PXRM(809,"C",PAT,EPNAME,DTE,""))
if IEN'>0
QUIT
+4 SET CNT=0
+5 SET INC=0
+6 FOR
SET INC=$ORDER(^PXRM(809,IEN,1,INC))
if INC'>0
QUIT
Begin DoDot:1
+7 SET NODE=$GET(^PXRM(809,IEN,1,INC,0))
+8 IF $PIECE(NODE,U)'["WV(790.1"
QUIT
+9 SET WVIEN=+$PIECE(NODE,U)
+10 IF $$NOOPEN^PXRMCWH(WVIEN,PAT,0,0)
QUIT
+11 ;D GETTEST(WVIEN,.CNT,.RESULT)
+12 SET TCNT=0
SET LDATE=$PIECE(NODE,U,5)
+13 DO GETWVP^PXRMCEOC(PAT,$PIECE(NODE,U),$PIECE(NODE,U,2),LDATE,1,.TEXT,.TCNT)
+14 SET TCNT=0
FOR
SET TCNT=$ORDER(TEXT(1,TCNT))
if TCNT'>0
QUIT
SET CNT=CNT+1
SET RESULT(CNT)=TEXT(1,TCNT)
+15 SET CNT=CNT+1
SET RESULT(CNT)=""
End DoDot:1
+16 QUIT
+17 ;
TIUSRCH(IEN,NIN,ARRAY) ;
+1 NEW CNT,INPUTS,OLIST,ONAME,TEXT,TLIST,TMP
+2 DO TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,35,.OLIST,.TLIST)
+3 SET CNT=0
FOR
SET CNT=$ORDER(OLIST(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+4 SET ONAME=OLIST(CNT)
+5 SET INPUTS("|"_ONAME_"|")="'FMT{|"_ONAME_"|}FMT"
End DoDot:1
+6 ;
+7 SET CNT=0
+8 FOR
SET CNT=$ORDER(^PXRMD(801.41,DIEN,35,CNT))
if CNT'>0
QUIT
Begin DoDot:1
+9 SET TMP=^PXRMD(801.41,DIEN,35,CNT,0)
+10 SET TEXT=$$REPLACE^XLFSTR(TMP,.INPUTS)
+11 SET NIN=NIN+1
SET ARRAY(NIN)=TEXT
End DoDot:1
+12 QUIT
+13 ;
