PXRMCOVID19 ;SLC/PKR - COVID-19 information for CPRS display. ;05/19/2020
;;2.0;CLINICAL REMINDERS;**72,46**;Feb 04, 2005;Build 236
;Supports ICR #7146.
;===============
CLICKTEXT(SUB,DEFIEN,DFN,TRUEFF) ;
N IND,STATUS
K ^TMP(SUB,$J)
S STATUS=1
I '$D(^TMP("PXRMCOVID19",$J,DEFIEN,DFN,TRUEFF)) D
. S STATUS=$$STATUS^PXRMCOVID19(DFN,DEFIEN)
I $P(STATUS,U,1)=-1 Q "-1^Error loading click text."
S IND=0
F S IND=$O(^TMP("PXRMCOVID19",$J,DEFIEN,DFN,TRUEFF,IND)) Q:IND="" D
. S ^TMP(SUB,$J,IND,0)=^TMP("PXRMCOVID19",$J,DEFIEN,DFN,TRUEFF,IND)
Q 1
;
;===============
STATUS(DFN,DEFINITION) ;Patient status.
N BANNERTEXT,DEFARR,DEFIEN,DONE,EVALDT,EVALSTATUS
N FFBYNUM,FFIND,FFTRUE,FIEVAL,FINUM,IFIEVAL,IND,NLINES
N PXRMITEM,PXRMRM,TEXTA,TRUEFF
I DFN="" Q "-1^COVID-19 Non-existent patient"
I '$D(^DPT(DFN)) Q "-1^COVID-19 Non-existent patient"
I +DEFINITION=DEFINITION S DEFIEN=DEFINITION
E S DEFIEN=$O(^PXD(811.9,"B",DEFINITION,""))
I DEFIEN="" Q "-1^COVID-19 Non-existent reminder definition"
I $D(^PXD(811.9,DEFIEN))<10 Q "-1^COVID-19 Non-existent reminder definition"
K ^TMP("PXRMCOVID19",$J,DEFIEN,DFN),^TMP("PXRHM",$J)
D DEF^PXRMLDR(DEFIEN,.DEFARR)
S EVALDT=$$NOW^XLFDT
D EVAL^PXRM(DFN,.DEFARR,5,1,.FIEVAL,EVALDT)
;Check the reminder evaluation status.
S IND=$O(^TMP("PXRHM",$J,DEFIEN,""))
S EVALSTATUS=$P(^TMP("PXRHM",$J,DEFIEN,IND),U,1)
K ^TMP("PXRHM",$J)
I (EVALSTATUS="CNBD")!(EVALSTATUS="ERROR") Q "-1^Reminder evaluation failure, status: "_EVALSTATUS
;Determine the COVID-19 status, by finding the first true function
;finding in numerical order.
S FFIND="FF"
F S FFIND=$O(FIEVAL(FFIND)) Q:FFIND'["FF" D
. S IND=+$P(FFIND,"FF",2),FFBYNUM(IND)=""
S (DONE,IND,TRUEFF)=0
F S IND=$O(FFBYNUM(IND)) Q:(DONE)!(IND="") D
. S FFIND="FF"_IND
. I FIEVAL(FFIND)=1 S TRUEFF=IND,DONE=1
I DONE=0 D Q TRUEFF_U_BANNERTEXT
. S TRUEFF=0,BANNERTEXT="COVID-19 Unable to determine status"
;
;Have the true function finding, process the objects in the
;found text.
S PXRMRM=80
S FFTRUE="FF"_TRUEFF,NLINES=0,PXRMITEM=DEFIEN
M IFIEVAL=FIEVAL("FF"_TRUEFF)
D FINDING^PXRMFNFT(DFN,FFTRUE,.FIEVAL,.IFIEVAL,.NLINES,.TEXTA)
;Return the first line of text for the CPRS banner, the remaining
;lines are the click text.
S BANNERTEXT=TEXTA(1)
F IND=2:1:NLINES S ^TMP("PXRMCOVID19",$J,DEFIEN,DFN,TRUEFF,IND-1)=TEXTA(IND)
Q TRUEFF_U_BANNERTEXT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCOVID19 2506 printed Dec 13, 2024@01:43:18 Page 2
PXRMCOVID19 ;SLC/PKR - COVID-19 information for CPRS display. ;05/19/2020
+1 ;;2.0;CLINICAL REMINDERS;**72,46**;Feb 04, 2005;Build 236
+2 ;Supports ICR #7146.
+3 ;===============
CLICKTEXT(SUB,DEFIEN,DFN,TRUEFF) ;
+1 NEW IND,STATUS
+2 KILL ^TMP(SUB,$JOB)
+3 SET STATUS=1
+4 IF '$DATA(^TMP("PXRMCOVID19",$JOB,DEFIEN,DFN,TRUEFF))
Begin DoDot:1
+5 SET STATUS=$$STATUS^PXRMCOVID19(DFN,DEFIEN)
End DoDot:1
+6 IF $PIECE(STATUS,U,1)=-1
QUIT "-1^Error loading click text."
+7 SET IND=0
+8 FOR
SET IND=$ORDER(^TMP("PXRMCOVID19",$JOB,DEFIEN,DFN,TRUEFF,IND))
if IND=""
QUIT
Begin DoDot:1
+9 SET ^TMP(SUB,$JOB,IND,0)=^TMP("PXRMCOVID19",$JOB,DEFIEN,DFN,TRUEFF,IND)
End DoDot:1
+10 QUIT 1
+11 ;
+12 ;===============
STATUS(DFN,DEFINITION) ;Patient status.
+1 NEW BANNERTEXT,DEFARR,DEFIEN,DONE,EVALDT,EVALSTATUS
+2 NEW FFBYNUM,FFIND,FFTRUE,FIEVAL,FINUM,IFIEVAL,IND,NLINES
+3 NEW PXRMITEM,PXRMRM,TEXTA,TRUEFF
+4 IF DFN=""
QUIT "-1^COVID-19 Non-existent patient"
+5 IF '$DATA(^DPT(DFN))
QUIT "-1^COVID-19 Non-existent patient"
+6 IF +DEFINITION=DEFINITION
SET DEFIEN=DEFINITION
+7 IF '$TEST
SET DEFIEN=$ORDER(^PXD(811.9,"B",DEFINITION,""))
+8 IF DEFIEN=""
QUIT "-1^COVID-19 Non-existent reminder definition"
+9 IF $DATA(^PXD(811.9,DEFIEN))<10
QUIT "-1^COVID-19 Non-existent reminder definition"
+10 KILL ^TMP("PXRMCOVID19",$JOB,DEFIEN,DFN),^TMP("PXRHM",$JOB)
+11 DO DEF^PXRMLDR(DEFIEN,.DEFARR)
+12 SET EVALDT=$$NOW^XLFDT
+13 DO EVAL^PXRM(DFN,.DEFARR,5,1,.FIEVAL,EVALDT)
+14 ;Check the reminder evaluation status.
+15 SET IND=$ORDER(^TMP("PXRHM",$JOB,DEFIEN,""))
+16 SET EVALSTATUS=$PIECE(^TMP("PXRHM",$JOB,DEFIEN,IND),U,1)
+17 KILL ^TMP("PXRHM",$JOB)
+18 IF (EVALSTATUS="CNBD")!(EVALSTATUS="ERROR")
QUIT "-1^Reminder evaluation failure, status: "_EVALSTATUS
+19 ;Determine the COVID-19 status, by finding the first true function
+20 ;finding in numerical order.
+21 SET FFIND="FF"
+22 FOR
SET FFIND=$ORDER(FIEVAL(FFIND))
if FFIND'["FF"
QUIT
Begin DoDot:1
+23 SET IND=+$PIECE(FFIND,"FF",2)
SET FFBYNUM(IND)=""
End DoDot:1
+24 SET (DONE,IND,TRUEFF)=0
+25 FOR
SET IND=$ORDER(FFBYNUM(IND))
if (DONE)!(IND="")
QUIT
Begin DoDot:1
+26 SET FFIND="FF"_IND
+27 IF FIEVAL(FFIND)=1
SET TRUEFF=IND
SET DONE=1
End DoDot:1
+28 IF DONE=0
Begin DoDot:1
+29 SET TRUEFF=0
SET BANNERTEXT="COVID-19 Unable to determine status"
End DoDot:1
QUIT TRUEFF_U_BANNERTEXT
+30 ;
+31 ;Have the true function finding, process the objects in the
+32 ;found text.
+33 SET PXRMRM=80
+34 SET FFTRUE="FF"_TRUEFF
SET NLINES=0
SET PXRMITEM=DEFIEN
+35 MERGE IFIEVAL=FIEVAL("FF"_TRUEFF)
+36 DO FINDING^PXRMFNFT(DFN,FFTRUE,.FIEVAL,.IFIEVAL,.NLINES,.TEXTA)
+37 ;Return the first line of text for the CPRS banner, the remaining
+38 ;lines are the click text.
+39 SET BANNERTEXT=TEXTA(1)
+40 FOR IND=2:1:NLINES
SET ^TMP("PXRMCOVID19",$JOB,DEFIEN,DFN,TRUEFF,IND-1)=TEXTA(IND)
+41 QUIT TRUEFF_U_BANNERTEXT
+42 ;
