PXRMIOPT ;SLC/PKR - Computed finding in/out patient status. ;02/06/2019
;;2.0;CLINICAL REMINDERS;**42**;Feb 04, 2005;Build 245
;
;====================
IOPT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,FIDATA,TEXT) ;Routine for the computed
;finding VA-INPATIENT/OUTPATIENT FINDINGS.
N ABBR,ABLIST,DEFARR,FIEN,FIEVAL,FILENUM,FIMOD,FIMODS,FIMODV
N FINDING,INOUT,ROOT,TFINDING
;
S TFINDING=$P(TEST,U,1)
S INOUT=$P(TEST,U,2)
S FIMODS=$P(TEST,U,3)
I INOUT="" S INOUT="INP"
S (NFOUND,TEST)=0
I TFINDING="" Q
I (INOUT'="INP"),(INOUT'="OUT") Q
;
S ABBR=$P(TFINDING,".",1),FINDING=$P(TFINDING,".",2)
D BLDALIST^PXRMVPTR(811.902,.01,.ABLIST)
I '$D(ABLIST(ABBR)) Q
S FILENUM=$P(ABLIST(ABBR),U,1)
S FIEN=+$$FIND1^DIC(FILENUM,"","ABX",FINDING)
I FIEN=0 Q
S ROOT=$P($$ROOT^DILFD(FILENUM),U,2)
S DEFARR(20,1,0)=FIEN_";"_ROOT
S $P(DEFARR(20,1,0),U,9)=BDT
S $P(DEFARR(20,1,0),U,11)=EDT
S $P(DEFARR(20,1,0),U,14)=NGET
;For health factors, Within Category Rank defaults to 0.
S $P(DEFARR(20,1,0),U,10)=0
;If a Finding Modifier was passed set it.
I FIMODS'="" D
. S FIMOD=$P(FIMODS,":",1)
. S FIMODV=$P(FIMODS,":",2)
. I FIMOD="USE INACTIVE PROBLEMS" S $P(DEFARR(20,1,0),U,9)=FIMODV
. I FIMOD="WITHIN CATEGORY RANK" S $P(DEFARR(20,1,0),U,10)=FIMODV
. I FIMOD="MH SCALE" S $P(DEFARR(20,1,0),U,12)=FIMODV
. I FIMOD="RX TYPE" S $P(DEFARR(20,1,0),U,13)=FIMODV
. I FIMOD="USE START DATE" S $P(DEFARR(20,1,0),U,15)=FIMODV
. I FIMOD="INCLUDE VISIT DATA" S $P(DEFARR(20,1,0),U,16)=FIMODV
S DEFARR("E",ROOT,FIEN,1)=""
D EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
I FIEVAL(1)=0 Q
;
N DATAINP,DATEINP,FINAME,IND,INPT,JND,JNDS,KND,MSG,NFINP,TESTINP,TEXTINP
S TESTINP=""
D WASINP^PXRMPDEM(DFN,99,BDT,EDT,.NFINP,.TESTINP,.DATEINP,.DATAINP,.TEXTINP)
I (NFINP=0),(INOUT="INP") Q
I (NFINP=0),(INOUT="OUT") D Q
. S IND=0
. F S IND=+$O(FIEVAL(1,IND)) Q:IND=0 D
.. I FIEVAL(1,IND)=1 S NFOUND=NFOUND+1,DATE(NFOUND)=FIEVAL(1,IND,"DATE"),TEST(NFOUND)=1
S FINAME=ABBR_"."_$$GET1^DIQ(FILENUM,FIEN_",",.01,"","","MSG")
S (IND,NFOUND)=0
F S IND=+$O(FIEVAL(1,IND)) Q:IND=0 D
. I FIEVAL(1,IND)=0 Q
. S INPT=0
. F JND=1:1:NFINP D
.. S INPT=((FIEVAL(1,IND,"DATE"))'<(DATAINP(JND,"ADMISSION DATE")))&((FIEVAL(1,IND,"DATE"))'>(DATAINP(JND,"DISCHARGE DATE")))
.. I INPT=1 S JNDS=JND,JND=NFINP
.;If INPT is true then the finding occurred during an inpatient stay.
. I ((INOUT="INP")&(INPT))!((INOUT="OUT")&('INPT))&(NFOUND<NGET) D
.. S NFOUND=NFOUND+1
.. S TEST(NFOUND)=1
.. S DATE(NFOUND)=FIEVAL(1,IND,"DATE")
.. I $G(PXRMDEBG)=1 K FIEVAL(1,IND,"CSUB")
.. S KND=1
.. F S KND=$O(FIEVAL(1,IND,KND)) Q:KND="" M FIDATA(NFOUND,KND)=FIEVAL(1,IND,KND)
.. I INOUT="INP" S TEXT(NFOUND)=TEXTINP(JNDS)_"\\"_FINAME_" "_$$EDATE^PXRMDATE(FIEVAL(1,IND,"DATE"))
.. I INOUT="OUT" S TEXT(NFOUND)="This instance of "_FINAME_" occurred outside of all inpatient stays."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMIOPT 2930 printed Apr 09, 2024@20:52:59 Page 2
PXRMIOPT ;SLC/PKR - Computed finding in/out patient status. ;02/06/2019
+1 ;;2.0;CLINICAL REMINDERS;**42**;Feb 04, 2005;Build 245
+2 ;
+3 ;====================
IOPT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,FIDATA,TEXT) ;Routine for the computed
+1 ;finding VA-INPATIENT/OUTPATIENT FINDINGS.
+2 NEW ABBR,ABLIST,DEFARR,FIEN,FIEVAL,FILENUM,FIMOD,FIMODS,FIMODV
+3 NEW FINDING,INOUT,ROOT,TFINDING
+4 ;
+5 SET TFINDING=$PIECE(TEST,U,1)
+6 SET INOUT=$PIECE(TEST,U,2)
+7 SET FIMODS=$PIECE(TEST,U,3)
+8 IF INOUT=""
SET INOUT="INP"
+9 SET (NFOUND,TEST)=0
+10 IF TFINDING=""
QUIT
+11 IF (INOUT'="INP")
IF (INOUT'="OUT")
QUIT
+12 ;
+13 SET ABBR=$PIECE(TFINDING,".",1)
SET FINDING=$PIECE(TFINDING,".",2)
+14 DO BLDALIST^PXRMVPTR(811.902,.01,.ABLIST)
+15 IF '$DATA(ABLIST(ABBR))
QUIT
+16 SET FILENUM=$PIECE(ABLIST(ABBR),U,1)
+17 SET FIEN=+$$FIND1^DIC(FILENUM,"","ABX",FINDING)
+18 IF FIEN=0
QUIT
+19 SET ROOT=$PIECE($$ROOT^DILFD(FILENUM),U,2)
+20 SET DEFARR(20,1,0)=FIEN_";"_ROOT
+21 SET $PIECE(DEFARR(20,1,0),U,9)=BDT
+22 SET $PIECE(DEFARR(20,1,0),U,11)=EDT
+23 SET $PIECE(DEFARR(20,1,0),U,14)=NGET
+24 ;For health factors, Within Category Rank defaults to 0.
+25 SET $PIECE(DEFARR(20,1,0),U,10)=0
+26 ;If a Finding Modifier was passed set it.
+27 IF FIMODS'=""
Begin DoDot:1
+28 SET FIMOD=$PIECE(FIMODS,":",1)
+29 SET FIMODV=$PIECE(FIMODS,":",2)
+30 IF FIMOD="USE INACTIVE PROBLEMS"
SET $PIECE(DEFARR(20,1,0),U,9)=FIMODV
+31 IF FIMOD="WITHIN CATEGORY RANK"
SET $PIECE(DEFARR(20,1,0),U,10)=FIMODV
+32 IF FIMOD="MH SCALE"
SET $PIECE(DEFARR(20,1,0),U,12)=FIMODV
+33 IF FIMOD="RX TYPE"
SET $PIECE(DEFARR(20,1,0),U,13)=FIMODV
+34 IF FIMOD="USE START DATE"
SET $PIECE(DEFARR(20,1,0),U,15)=FIMODV
+35 IF FIMOD="INCLUDE VISIT DATA"
SET $PIECE(DEFARR(20,1,0),U,16)=FIMODV
End DoDot:1
+36 SET DEFARR("E",ROOT,FIEN,1)=""
+37 DO EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
+38 IF FIEVAL(1)=0
QUIT
+39 ;
+40 NEW DATAINP,DATEINP,FINAME,IND,INPT,JND,JNDS,KND,MSG,NFINP,TESTINP,TEXTINP
+41 SET TESTINP=""
+42 DO WASINP^PXRMPDEM(DFN,99,BDT,EDT,.NFINP,.TESTINP,.DATEINP,.DATAINP,.TEXTINP)
+43 IF (NFINP=0)
IF (INOUT="INP")
QUIT
+44 IF (NFINP=0)
IF (INOUT="OUT")
Begin DoDot:1
+45 SET IND=0
+46 FOR
SET IND=+$ORDER(FIEVAL(1,IND))
if IND=0
QUIT
Begin DoDot:2
+47 IF FIEVAL(1,IND)=1
SET NFOUND=NFOUND+1
SET DATE(NFOUND)=FIEVAL(1,IND,"DATE")
SET TEST(NFOUND)=1
End DoDot:2
End DoDot:1
QUIT
+48 SET FINAME=ABBR_"."_$$GET1^DIQ(FILENUM,FIEN_",",.01,"","","MSG")
+49 SET (IND,NFOUND)=0
+50 FOR
SET IND=+$ORDER(FIEVAL(1,IND))
if IND=0
QUIT
Begin DoDot:1
+51 IF FIEVAL(1,IND)=0
QUIT
+52 SET INPT=0
+53 FOR JND=1:1:NFINP
Begin DoDot:2
+54 SET INPT=((FIEVAL(1,IND,"DATE"))'<(DATAINP(JND,"ADMISSION DATE")))&((FIEVAL(1,IND,"DATE"))'>(DATAINP(JND,"DISCHARGE DATE")))
+55 IF INPT=1
SET JNDS=JND
SET JND=NFINP
End DoDot:2
+56 ;If INPT is true then the finding occurred during an inpatient stay.
+57 IF ((INOUT="INP")&(INPT))!((INOUT="OUT")&('INPT))&(NFOUND<NGET)
Begin DoDot:2
+58 SET NFOUND=NFOUND+1
+59 SET TEST(NFOUND)=1
+60 SET DATE(NFOUND)=FIEVAL(1,IND,"DATE")
+61 IF $GET(PXRMDEBG)=1
KILL FIEVAL(1,IND,"CSUB")
+62 SET KND=1
+63 FOR
SET KND=$ORDER(FIEVAL(1,IND,KND))
if KND=""
QUIT
MERGE FIDATA(NFOUND,KND)=FIEVAL(1,IND,KND)
+64 IF INOUT="INP"
SET TEXT(NFOUND)=TEXTINP(JNDS)_"\\"_FINAME_" "_$$EDATE^PXRMDATE(FIEVAL(1,IND,"DATE"))
+65 IF INOUT="OUT"
SET TEXT(NFOUND)="This instance of "_FINAME_" occurred outside of all inpatient stays."
End DoDot:2
End DoDot:1
+66 QUIT
+67 ;
