- 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 Feb 18, 2025@23:09:40 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 ;