PXHFMEASREPAIR ;SLC/PKR - Repair V Health Factor entries that have corrupted measurements. ;05/03/2023
;;1.0;PCE PATIENT CARE ENCOUNTER;**234**;Aug 12, 1996;Build 6
;
; Reference Field ICR#
;^DPT(D0,0) .01 NAME 0;1 10035
;
;===============================
EDITMEASUREMENT ;Let the user select V HF entries and edit the measurement.
N COMMENTS,DA,DIC,DIE,DONE,DR,HFIEN,HFNAME,HFTEMP220,MAGNITUDE,MAX,MIN,MAXDEC
N NUMNULL,NUMVHFDEC,NL,TEXT,UCUMCODE,UCUMIEN,VALID,VHFDEC,VHFTEMP220,VHFUCUMIEN,Y
S (DIC,DIE)=9000010.23
S DIC("A")="Input the internal entry number, or press ENTER to exit: "
S DR="220;221"
W !,"Edit the measurement for selected V HEALTH FACTOR entries."
S DONE=0
F Q:DONE D
. S DIC(0)="AEN"
. D ^DIC
. I Y=-1 S DONE=1 Q
. S DA=$P(Y,U,1)
.;Display the HF information for the user.
. S HFIEN=$P(^AUPNVHF(DA,0),U,1)
. S COMMENTS=$G(^AUPNVHF(DA,811))
. S HFNAME=$P(^AUTTHF(HFIEN,0),U,1)
. S HFTEMP220=$G(^AUTTHF(HFIEN,220))
. S MIN=$P(HFTEMP220,U,1),MAX=$P(HFTEMP220,U,2)
. S MAXDEC=$P(HFTEMP220,U,3),UCUMIEN=$P(HFTEMP220,U,4)
. S UCUMCODE=$S(UCUMIEN>0:$$UCUMFIELDS^PXUCUM(UCUMIEN,"DESCRIPTION"),1:"")
. S NUMNULL=0
. I MIN="" S NUMNULL=NUMNULL+1
. I MAX="" S NUMNULL=NUMNULL+1
. I MAXDEC="" S NUMNULL=NUMNULL+1
. I UCUMIEN="" S NUMNULL=NUMNULL+1
. W !!,"Health Factor: ",HFNAME
. I NUMNULL=4 W !,"A measurement is not defined for this health factor."
. I (NUMNULL>0),(NUMNULL<4) W !,"The measurement is not completly defined for this health factor."
. I NUMNULL=0 D
.. W !," MINIMUM VALUE: ",MIN
.. W !," MAXIMUM VALUE: ",MAX
.. W !," MAXIMUM DECIMALS: ",MAXDEC
.. W !," UCUM DESCRIPTION: ",UCUMCODE
. W !," COMMENTS: ",COMMENTS
. W !
. S VALID=0
. F Q:VALID D
.. D ^DIE
..;Validate the user's input.
.. S NL=1,TEXT(NL)=""
.. K TEXT
.. S VALID=1
.. S VHFTEMP220=$G(^AUPNVHF(DA,220))
.. S MAGNITUDE=$P(VHFTEMP220,U,1)
.. S VHFUCUMIEN=$P(VHFTEMP220,U,2)
.. S NUMVHFDEC=$L($P(MAGNITUDE,".",2))
.. I (MAGNITUDE=""),(VHFUCUMIEN'="") D
... S NL=NL+1,TEXT(NL)="MAGNITUDE is NULL, but UCUM CODE is not NULL."
... S VALID=0
.. I (MAGNITUDE'=""),(VHFUCUMIEN="") D
... S NL=NL+1,TEXT(NL)="MAGNITUDE is not NULL, but UCUM CODE is NULL."
... S VALID=0
.. I (MAGNITUDE'=""),((MAGNITUDE<MIN)!(MAGNITUDE>MAX)) D
... S NL=NL+1,TEXT(NL)=MAGNITUDE_" is not in the inclusive range "_MIN_" to "_MAX_"."
... S VALID=0
.. I NUMVHFDEC>MAXDEC D
... S NL=NL+1,TEXT(NL)="The maximum number of decimals is exceeded."
... S VALID=0
.. I (VHFUCUMIEN'=""),(VHFUCUMIEN'=UCUMIEN) D
... S NL=NL+1,TEXT(NL)="The V HEALTH FACTORS UCUM CODE does not match the HEALTH FACTORS UCUM CODE."
... S VALID=0
.. I 'VALID D EN^DDIOL(.TEXT)
Q
;
;===============================
LCSHF(HFIEN,VHFIEN,MEASDEF,NUMREPAIRED) ;Special handling for the LCS HFs, if what is stored
;in COMMENTS is a valid magnitude use it.
N COMMENTS,DEC,DECLEN,MAGNITUDE,NUMBER,ORGMAG,TEMP220,UCUMIEN,VALIDNUM,VHFTEMP220
S VHFTEMP220=$G(^AUPNVHF(VHFIEN,220))
S (MAGNITUDE,ORGMAG)=$P(VHFTEMP220,U,1)
S UCUMIEN=$P(VHFTEMP220,U,2)
;If MAGNITUDE is NULL try to get a number from COMMENTS.
I MAGNITUDE="" D
. S COMMENTS=$G(^AUPNVHF(VHFIEN,811))
. I COMMENTS="" Q
. S NUMBER=+COMMENTS
. S VALIDNUM=$S(NUMBER=COMMENTS:1,1:0)
. I 'VALIDNUM S VALIDNUM=$$NUMCHECK(COMMENTS)
. I 'VALIDNUM Q
. I (NUMBER<MEASDEF("MIN"))!(NUMBER>MEASDEF("MAX")) Q
. S MAGNITUDE=NUMBER
;Could not obtain a valid MAGNITUDE, remove anything on the 220 node.
I MAGNITUDE="" D Q
. K ^AUPNVHF(VHFIEN,220)
. S ^TMP("PXNOREPAIR",$J,HFIEN,VHFIEN)="",NUMNOTREPAIRED=NUMNOTREPAIRED+1
I (MAGNITUDE<MEASDEF("MIN"))!(MAGNITUDE>MEASDEF("MAX")) D Q
. S ^TMP("PXNOREPAIR",$J,HFIEN,VHFIEN)="",NUMNOTREPAIRED=NUMNOTREPAIRED+1
;Have a MAGNITUDE, make sure the number of decimals does not exceed MAXDEC.
S DEC=$P(MAGNITUDE,".",2),DECLEN=$L(DEC)
I DECLEN>MEASDEF("MAXDEC") S MAGNITUDE=$FN(MAGNITUDE,"",MEASDEF("MAXDEC"))
;Store the measurement using the UCUM from the health factor.
I (MAGNITUDE'=ORGMAG)!(UCUMIEN'=MEASDEF("UCUMIEN")) D
. S ^AUPNVHF(VHFIEN,220)=MAGNITUDE_U_MEASDEF("UCUMIEN")
. S NUMREPAIRED=NUMREPAIRED+1
Q
;
;===============================
NUMCHECK(COMMENTS) ;Verify all the characters in COMMENTS are numbers or ".".
N ASCII,CHAR,DONE,IND,LEN,VALID
S LEN=$L(COMMENTS)
S (DONE,IND)=0,VALID=1
F Q:(DONE)!(IND=LEN) D
. S IND=IND+1
. S CHAR=$E(COMMENTS,IND)
. S ASCII=$A(CHAR)
. I ASCII=46 Q
. I (ASCII<48)!(ASCII>57) S DONE=1,VALID=0
Q VALID
;
;===============================
REPAIR ;Repair V Health Factor entries that have corrupted measurements.
N COMMENTS,DEC,DECLEN,HFIEN,HFTEMP220,LCSHF,LCSPACKDAY,LCSYEARSSMOKED,MAGNITUDE,MEASDEF
N NUMBER,NUMREPAIRED,NUMNOTREPAIRED,ORGMAG,UCUMIEN,VALIDNUM,VHFIEN,VHFTEMP220
K ^TMP("PXMEASDEF",$J),^TMP("PXNOREPAIR",$J)
;Get the IEN of the LCS health factors.
S LCSPACKDAY=$O(^AUTTHF("B","LCS PACKS/DAY",""))
S LCSYEARSSMOKED=$O(^AUTTHF("B","LCS YEARS SMOKED",""))
S (HFIEN,NUMREPAIRED,NUMNOTREPAIRED)=0
F S HFIEN=+$O(^AUPNVHF("B",HFIEN)) Q:HFIEN=0 D
. I (HFIEN=LCSPACKDAY)!(HFIEN=LCSYEARSSMOKED) S LCSHF=1
. E S LCSHF=0
. S HFTEMP220=$G(^AUTTHF(HFIEN,220))
. I HFTEMP220'="" D
.. S MEASDEF("MIN")=$P(HFTEMP220,U,1)
.. S MEASDEF("MAX")=$P(HFTEMP220,U,2)
.. S MEASDEF("MAXDEC")=$P(HFTEMP220,U,3)
.. S MEASDEF("UCUMIEN")=$P(HFTEMP220,U,4)
.. S MEASDEF("PROMPT CAPTION")=$P(HFTEMP220,U,5)
.. S MEASDEF("UCUM DISPLAY")=$P(HFTEMP220,U,6)
.. I '$$VALIDMEASDEF(.MEASDEF) S ^TMP("PXMEASDEF",$J,HFIEN)=""
. I HFTEMP220="" S (MEASDEF("MIN"),MEASDEF("MAX"),MEASDEF("MAXDEC"),MEASDEF("UCUMIEN"),MEASDEF("PROMPT CAPTION"),MEASDEF("UCUM DISPLAY"))=""
. S MEASDEF=$S(MEASDEF("MIN")="":0,MEASDEF("MAX")="":0,1:1)
. S VHFIEN=0
. F S VHFIEN=+$O(^AUPNVHF("B",HFIEN,VHFIEN)) Q:VHFIEN=0 D
.. I LCSHF D LCSHF(HFIEN,VHFIEN,.MEASDEF,.NUMREPAIRED) Q
.. S VHFTEMP220=$G(^AUPNVHF(VHFIEN,220))
.. S (MAGNITUDE,ORGMAG)=$P(VHFTEMP220,U,1)
.. S UCUMIEN=$P(VHFTEMP220,U,2)
..;If the HF does not have a measurement defined delete the VHF 220 node.
..;The 220 node could be ^.
.. I (MEASDEF=0),((MAGNITUDE'="")!(UCUMIEN'="")) D Q
... S ^AUPNVHF(VHFIEN,220)="",NUMREPAIRED=NUMREPAIRED+1
.. I (MAGNITUDE=""),(UCUMIEN="") Q
..;If the units do not match automatic repair is not posible.
.. I UCUMIEN'=MEASDEF("UCUMIEN") S ^TMP("PXNOREPAIR",$J,HFIEN,VHFIEN)="",NUMNOTREPAIRED=NUMNOTREPAIRED+1 Q
.. ;If MAGNITUDE is NULL try to get a number from COMMENTS.
.. I MAGNITUDE="" D
... S COMMENTS=$G(^AUPNVHF(VHFIEN,811))
... I COMMENTS="" Q
... S NUMBER=+COMMENTS
... S VALIDNUM=$S(NUMBER=COMMENTS:1,1:0)
... I 'VALIDNUM S VALIDNUM=$$NUMCHECK(COMMENTS)
... I 'VALIDNUM Q
... I (NUMBER<MEASDEF("MIN"))!(NUMBER>MEASDEF("MAX")) Q
... S MAGNITUDE=NUMBER
..;Could not obtain a valid MAGNITUDE, remove anything on the 220 node.
.. I MAGNITUDE="" D Q
... K ^AUPNVHF(VHFIEN,220)
... S ^TMP("PXNOREPAIR",$J,HFIEN,VHFIEN)="",NUMNOTREPAIRED=NUMNOTREPAIRED+1
.. I (MAGNITUDE<MEASDEF("MIN"))!(MAGNITUDE>MEASDEF("MAX")) D Q
... S ^TMP("PXNOREPAIR",$J,HFIEN,VHFIEN)="",NUMNOTREPAIRED=NUMNOTREPAIRED+1
.. ;Have a MAGNITUDE, make sure the number of decimals does not exceed MAXDEC.
.. S DEC=$P(MAGNITUDE,".",2),DECLEN=$L(DEC)
.. I DECLEN>MEASDEF("MAXDEC") S MAGNITUDE=$FN(MAGNITUDE,"",MEASDEF("MAXDEC"))
.. I MAGNITUDE'=ORGMAG D
... S ^AUPNVHF(VHFIEN,220)=MAGNITUDE_U_MEASDEF("UCUMIEN")
... S NUMREPAIRED=NUMREPAIRED+1
D SENDVHFMESSAGE(NUMREPAIRED,NUMNOTREPAIRED)
I $D(^TMP("PXMEASDEF",$J)) D SENDHFMESSAGE
K ^TMP("PXMEASDEF",$J),^TMP("PXNOREPAIR",$J)
Q
;
;===============================
SENDHFMESSAGE ;Send a MailMan message to the PCE Management Repair mail group
;listing the HF entries with incomplete measurement definitions.
N HFIEN,MGIEN,MGROUP,NAME,NL,SUBJECT,TO,VALUE
S SUBJECT="HEALTH FACTORS WITH INCOMPLETE MEASUREMENT DEFINITION"
S MGIEN=+$G(^PX(815,1,650))
I MGIEN>0 D
. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
. S TO(MGROUP)=""
S TO(DUZ)=""
K ^TMP("PXHFMSG",$J)
S ^TMP("PXHFMSG",$J,1,0)="The following health factors have incomplete measurement definitions, they"
S ^TMP("PXHFMSG",$J,2,0)="should be completed as soon as possible."
S NL=2
S HFIEN=0
F S HFIEN=$O(^TMP("PXMEASDEF",$J,HFIEN)) Q:HFIEN="" D
. S NAME=$P(^AUTTHF(HFIEN,0),U,1)
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=""
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=NAME
. S HFTEMP220=$G(^AUTTHF(HFIEN,220))
. S VALUE=$P(HFTEMP220,U,1)
. I VALUE="" S VALUE="Missing"
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=" MINIMUM VALUE: "_VALUE
. S VALUE=$P(HFTEMP220,U,2)
. I VALUE="" S VALUE="Missing"
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=" MAXIMUM VALUE: "_VALUE
. S VALUE=$P(HFTEMP220,U,3)
. I VALUE="" S VALUE="Missing"
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=" MAXIMUM DECIMALS: "_VALUE
. S VALUE=$P(HFTEMP220,U,4)
. S VALUE=$S(VALUE'="":$$UCUMFIELDS^PXUCUM(VALUE,"DESCRIPTION"),1:"Missing")
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=" UCUM CODE: "_VALUE
. S VALUE=$P(HFTEMP220,U,5)
. I VALUE="" S VALUE="Missing"
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=" PROMPT CAPTION: "_VALUE
. S VALUE=$P(HFTEMP220,U,6)
. I VALUE="" S VALUE="Missing"
. S NL=NL+1,^TMP("PXHFMSG",$J,NL,0)=" UCUM DISPLAY: "_VALUE
D SEND^PXMSG("PXHFMSG",SUBJECT,.TO)
K ^TMP("PXHFMSG",$J)
Q
;
;===============================
SENDVHFMESSAGE(NUMREPAIRED,NUMNOTREPAIRED) ;Send a MailMan message to the PCE Management Repair mail group
;listing the VHF entries whose measurement could not be repaired.
N DFN,HF,HFIEN,HFTEMP220,MAGNITUDE,MAX,MAXDEC,MGIEN,MGROUP,MIN,PATIENT,NL,NOW
N SUBJECT,TEMP,TO,UCUMCODE,UCUMIEN,VHFIEN,VHFTEMP220,VISITDT,VISITIEN
K ^TMP("PXVHFMSG",$J)
S SUBJECT="V HEALTH FACTORS MEASUREMENT REPAIR"
S MGIEN=+$G(^PX(815,1,650))
I MGIEN>0 D
. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
. S TO(MGROUP)=""
S TO(DUZ)=""
S NOW=$$NOW^XLFDT
S ^TMP("PXVHFMSG",$J,1,0)="V HEALTH FACTORS measurement repair completed at "_$$FMTE^XLFDT(NOW)
S ^TMP("PXVHFMSG",$J,2,0)="Measurements were repaired for "_NUMREPAIRED_" entries."
I '$D(^TMP("PXNOREPAIR",$J)) D Q
. D SEND^PXMSG("PXVHFMSG",SUBJECT,.TO)
. K ^TMP("PXVHFMSG",$J)
S ^TMP("PXVHFMSG",$J,3,0)="There were "_NUMNOTREPAIRED_" V HEALTH FACTORS entries that could not be automatically"
S ^TMP("PXVHFMSG",$J,4,0)="repaired:"
S HFIEN=0,NL=4
F S HFIEN=$O(^TMP("PXNOREPAIR",$J,HFIEN)) Q:HFIEN="" D
. S HF=$P(^AUTTHF(HFIEN,0),U,1)
. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)=""
. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)="Health Factor: "_HF
. S HFTEMP220=^AUTTHF(HFIEN,220)
. S MIN=$P(HFTEMP220,U,1)
. S MAX=$P(HFTEMP220,U,2)
. S MAXDEC=$P(HFTEMP220,U,3)
. S UCUMIEN=$P(HFTEMP220,U,4)
. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)="Minimum Value: "_MIN_" Maximum Value: "_MAX
. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)="Maximum Decimals: "_MAXDEC
. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)="UCUM Code: "_$$UCUMFIELDS^PXUCUM(UCUMIEN,"DESCRIPTION")
. S VHFIEN=0
. F S VHFIEN=$O(^TMP("PXNOREPAIR",$J,HFIEN,VHFIEN)) Q:VHFIEN="" D
.. S TEMP=^AUPNVHF(VHFIEN,0)
.. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)=""
.. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)=" V Health Factors IEN: "_VHFIEN
.. S DFN=$P(TEMP,U,2),PATIENT=$P(^DPT(DFN,0),U,1)
.. S VISITIEN=$P(TEMP,U,3),VISITDT=$P(^AUPNVSIT(VISITIEN,0),U,1)
.. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)=" Visit: "_$$FMTE^XLFDT(VISITDT)
.. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)=" Patient: "_PATIENT
.. S VHFTEMP220=$G(^AUPNVHF(VHFIEN,220))
.. S MAGNITUDE=$P(VHFTEMP220,U,1)
.. I MAGNITUDE="" S MAGNITUDE="Missing"
.. S UCUMIEN=$P(VHFTEMP220,U,2)
.. I UCUMIEN>0 S UCUMCODE=$$UCUMFIELDS^PXUCUM(UCUMIEN,"DESCRIPTION")
.. E S UCUMCODE="Missing"
.. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)=" MAGNITUDE: "_MAGNITUDE_"; UCUM CODE: "_UCUMCODE
.. S NL=NL+1,^TMP("PXVHFMSG",$J,NL,0)=" Comments: "_$G(^AUPNVHF(VHFIEN,811))
D SEND^PXMSG("PXVHFMSG",SUBJECT,.TO)
K ^TMP("PXVHFMSG",$J)
Q
;
;===============================
TASKREPAIR ;Run REPAIR^PXHFMEASREPAIR as a TaskMan job.
N TEXT,ZTDTH,ZTSAVE,ZTIO,ZTSK,ZTRTN,ZTDESC,ZTUCI,ZTCPU,ZTSYNC,ZTKIL
S ZTRTN="REPAIR^PXHFMEASREPAIR"
S ZTDESC="Repair corrupted V HEALTH FACTORS measurements"
S ZTIO=""
S ZTDTH=$H
D ^%ZTLOAD
I $G(ZTSK) D
. S TEXT="V HEALTH FACTORS measurement repair has been queued, task number: "_ZTSK
. D BMES^XPDUTL(.TEXT)
I '$G(ZTSK) D
. S TEXT="V HEALTH FACTORS measurement repair failed to queue. Please create a ticket."
. D BMES^XPDUTL(.TEXT)
Q
;
;===============================
VALIDMEASDEF(MEASDEF) ;Make sure a measurement is completely defined.
N NUMNULL
S NUMNULL=0
I MEASDEF("MIN")="" S NUMNULL=NUMNULL+1
I MEASDEF("MAX")="" S NUMNULL=NUMNULL+1
I MEASDEF("MAXDEC")="" S NUMNULL=NUMNULL+1
I MEASDEF("UCUMIEN")="" S NUMNULL=NUMNULL+1
I MEASDEF("PROMPT CAPTION")="" S NUMNULL=NUMNULL+1
I MEASDEF("UCUM DISPLAY")="" S NUMNULL=NUMNULL+1
Q $S(NUMNULL=0:1,1:0)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXHFMEASREPAIR 13063 printed May 21, 2024@02:25:29 Page 2
PXHFMEASREPAIR ;SLC/PKR - Repair V Health Factor entries that have corrupted measurements. ;05/03/2023
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**234**;Aug 12, 1996;Build 6
+2 ;
+3 ; Reference Field ICR#
+4 ;^DPT(D0,0) .01 NAME 0;1 10035
+5 ;
+6 ;===============================
EDITMEASUREMENT ;Let the user select V HF entries and edit the measurement.
+1 NEW COMMENTS,DA,DIC,DIE,DONE,DR,HFIEN,HFNAME,HFTEMP220,MAGNITUDE,MAX,MIN,MAXDEC
+2 NEW NUMNULL,NUMVHFDEC,NL,TEXT,UCUMCODE,UCUMIEN,VALID,VHFDEC,VHFTEMP220,VHFUCUMIEN,Y
+3 SET (DIC,DIE)=9000010.23
+4 SET DIC("A")="Input the internal entry number, or press ENTER to exit: "
+5 SET DR="220;221"
+6 WRITE !,"Edit the measurement for selected V HEALTH FACTOR entries."
+7 SET DONE=0
+8 FOR
if DONE
QUIT
Begin DoDot:1
+9 SET DIC(0)="AEN"
+10 DO ^DIC
+11 IF Y=-1
SET DONE=1
QUIT
+12 SET DA=$PIECE(Y,U,1)
+13 ;Display the HF information for the user.
+14 SET HFIEN=$PIECE(^AUPNVHF(DA,0),U,1)
+15 SET COMMENTS=$GET(^AUPNVHF(DA,811))
+16 SET HFNAME=$PIECE(^AUTTHF(HFIEN,0),U,1)
+17 SET HFTEMP220=$GET(^AUTTHF(HFIEN,220))
+18 SET MIN=$PIECE(HFTEMP220,U,1)
SET MAX=$PIECE(HFTEMP220,U,2)
+19 SET MAXDEC=$PIECE(HFTEMP220,U,3)
SET UCUMIEN=$PIECE(HFTEMP220,U,4)
+20 SET UCUMCODE=$SELECT(UCUMIEN>0:$$UCUMFIELDS^PXUCUM(UCUMIEN,"DESCRIPTION"),1:"")
+21 SET NUMNULL=0
+22 IF MIN=""
SET NUMNULL=NUMNULL+1
+23 IF MAX=""
SET NUMNULL=NUMNULL+1
+24 IF MAXDEC=""
SET NUMNULL=NUMNULL+1
+25 IF UCUMIEN=""
SET NUMNULL=NUMNULL+1
+26 WRITE !!,"Health Factor: ",HFNAME
+27 IF NUMNULL=4
WRITE !,"A measurement is not defined for this health factor."
+28 IF (NUMNULL>0)
IF (NUMNULL<4)
WRITE !,"The measurement is not completly defined for this health factor."
+29 IF NUMNULL=0
Begin DoDot:2
+30 WRITE !," MINIMUM VALUE: ",MIN
+31 WRITE !," MAXIMUM VALUE: ",MAX
+32 WRITE !," MAXIMUM DECIMALS: ",MAXDEC
+33 WRITE !," UCUM DESCRIPTION: ",UCUMCODE
End DoDot:2
+34 WRITE !," COMMENTS: ",COMMENTS
+35 WRITE !
+36 SET VALID=0
+37 FOR
if VALID
QUIT
Begin DoDot:2
+38 DO ^DIE
+39 ;Validate the user's input.
+40 SET NL=1
SET TEXT(NL)=""
+41 KILL TEXT
+42 SET VALID=1
+43 SET VHFTEMP220=$GET(^AUPNVHF(DA,220))
+44 SET MAGNITUDE=$PIECE(VHFTEMP220,U,1)
+45 SET VHFUCUMIEN=$PIECE(VHFTEMP220,U,2)
+46 SET NUMVHFDEC=$LENGTH($PIECE(MAGNITUDE,".",2))
+47 IF (MAGNITUDE="")
IF (VHFUCUMIEN'="")
Begin DoDot:3
+48 SET NL=NL+1
SET TEXT(NL)="MAGNITUDE is NULL, but UCUM CODE is not NULL."
+49 SET VALID=0
End DoDot:3
+50 IF (MAGNITUDE'="")
IF (VHFUCUMIEN="")
Begin DoDot:3
+51 SET NL=NL+1
SET TEXT(NL)="MAGNITUDE is not NULL, but UCUM CODE is NULL."
+52 SET VALID=0
End DoDot:3
+53 IF (MAGNITUDE'="")
IF ((MAGNITUDE<MIN)!(MAGNITUDE>MAX))
Begin DoDot:3
+54 SET NL=NL+1
SET TEXT(NL)=MAGNITUDE_" is not in the inclusive range "_MIN_" to "_MAX_"."
+55 SET VALID=0
End DoDot:3
+56 IF NUMVHFDEC>MAXDEC
Begin DoDot:3
+57 SET NL=NL+1
SET TEXT(NL)="The maximum number of decimals is exceeded."
+58 SET VALID=0
End DoDot:3
+59 IF (VHFUCUMIEN'="")
IF (VHFUCUMIEN'=UCUMIEN)
Begin DoDot:3
+60 SET NL=NL+1
SET TEXT(NL)="The V HEALTH FACTORS UCUM CODE does not match the HEALTH FACTORS UCUM CODE."
+61 SET VALID=0
End DoDot:3
+62 IF 'VALID
DO EN^DDIOL(.TEXT)
End DoDot:2
End DoDot:1
+63 QUIT
+64 ;
+65 ;===============================
LCSHF(HFIEN,VHFIEN,MEASDEF,NUMREPAIRED) ;Special handling for the LCS HFs, if what is stored
+1 ;in COMMENTS is a valid magnitude use it.
+2 NEW COMMENTS,DEC,DECLEN,MAGNITUDE,NUMBER,ORGMAG,TEMP220,UCUMIEN,VALIDNUM,VHFTEMP220
+3 SET VHFTEMP220=$GET(^AUPNVHF(VHFIEN,220))
+4 SET (MAGNITUDE,ORGMAG)=$PIECE(VHFTEMP220,U,1)
+5 SET UCUMIEN=$PIECE(VHFTEMP220,U,2)
+6 ;If MAGNITUDE is NULL try to get a number from COMMENTS.
+7 IF MAGNITUDE=""
Begin DoDot:1
+8 SET COMMENTS=$GET(^AUPNVHF(VHFIEN,811))
+9 IF COMMENTS=""
QUIT
+10 SET NUMBER=+COMMENTS
+11 SET VALIDNUM=$SELECT(NUMBER=COMMENTS:1,1:0)
+12 IF 'VALIDNUM
SET VALIDNUM=$$NUMCHECK(COMMENTS)
+13 IF 'VALIDNUM
QUIT
+14 IF (NUMBER<MEASDEF("MIN"))!(NUMBER>MEASDEF("MAX"))
QUIT
+15 SET MAGNITUDE=NUMBER
End DoDot:1
+16 ;Could not obtain a valid MAGNITUDE, remove anything on the 220 node.
+17 IF MAGNITUDE=""
Begin DoDot:1
+18 KILL ^AUPNVHF(VHFIEN,220)
+19 SET ^TMP("PXNOREPAIR",$JOB,HFIEN,VHFIEN)=""
SET NUMNOTREPAIRED=NUMNOTREPAIRED+1
End DoDot:1
QUIT
+20 IF (MAGNITUDE<MEASDEF("MIN"))!(MAGNITUDE>MEASDEF("MAX"))
Begin DoDot:1
+21 SET ^TMP("PXNOREPAIR",$JOB,HFIEN,VHFIEN)=""
SET NUMNOTREPAIRED=NUMNOTREPAIRED+1
End DoDot:1
QUIT
+22 ;Have a MAGNITUDE, make sure the number of decimals does not exceed MAXDEC.
+23 SET DEC=$PIECE(MAGNITUDE,".",2)
SET DECLEN=$LENGTH(DEC)
+24 IF DECLEN>MEASDEF("MAXDEC")
SET MAGNITUDE=$FNUMBER(MAGNITUDE,"",MEASDEF("MAXDEC"))
+25 ;Store the measurement using the UCUM from the health factor.
+26 IF (MAGNITUDE'=ORGMAG)!(UCUMIEN'=MEASDEF("UCUMIEN"))
Begin DoDot:1
+27 SET ^AUPNVHF(VHFIEN,220)=MAGNITUDE_U_MEASDEF("UCUMIEN")
+28 SET NUMREPAIRED=NUMREPAIRED+1
End DoDot:1
+29 QUIT
+30 ;
+31 ;===============================
NUMCHECK(COMMENTS) ;Verify all the characters in COMMENTS are numbers or ".".
+1 NEW ASCII,CHAR,DONE,IND,LEN,VALID
+2 SET LEN=$LENGTH(COMMENTS)
+3 SET (DONE,IND)=0
SET VALID=1
+4 FOR
if (DONE)!(IND=LEN)
QUIT
Begin DoDot:1
+5 SET IND=IND+1
+6 SET CHAR=$EXTRACT(COMMENTS,IND)
+7 SET ASCII=$ASCII(CHAR)
+8 IF ASCII=46
QUIT
+9 IF (ASCII<48)!(ASCII>57)
SET DONE=1
SET VALID=0
End DoDot:1
+10 QUIT VALID
+11 ;
+12 ;===============================
REPAIR ;Repair V Health Factor entries that have corrupted measurements.
+1 NEW COMMENTS,DEC,DECLEN,HFIEN,HFTEMP220,LCSHF,LCSPACKDAY,LCSYEARSSMOKED,MAGNITUDE,MEASDEF
+2 NEW NUMBER,NUMREPAIRED,NUMNOTREPAIRED,ORGMAG,UCUMIEN,VALIDNUM,VHFIEN,VHFTEMP220
+3 KILL ^TMP("PXMEASDEF",$JOB),^TMP("PXNOREPAIR",$JOB)
+4 ;Get the IEN of the LCS health factors.
+5 SET LCSPACKDAY=$ORDER(^AUTTHF("B","LCS PACKS/DAY",""))
+6 SET LCSYEARSSMOKED=$ORDER(^AUTTHF("B","LCS YEARS SMOKED",""))
+7 SET (HFIEN,NUMREPAIRED,NUMNOTREPAIRED)=0
+8 FOR
SET HFIEN=+$ORDER(^AUPNVHF("B",HFIEN))
if HFIEN=0
QUIT
Begin DoDot:1
+9 IF (HFIEN=LCSPACKDAY)!(HFIEN=LCSYEARSSMOKED)
SET LCSHF=1
+10 IF '$TEST
SET LCSHF=0
+11 SET HFTEMP220=$GET(^AUTTHF(HFIEN,220))
+12 IF HFTEMP220'=""
Begin DoDot:2
+13 SET MEASDEF("MIN")=$PIECE(HFTEMP220,U,1)
+14 SET MEASDEF("MAX")=$PIECE(HFTEMP220,U,2)
+15 SET MEASDEF("MAXDEC")=$PIECE(HFTEMP220,U,3)
+16 SET MEASDEF("UCUMIEN")=$PIECE(HFTEMP220,U,4)
+17 SET MEASDEF("PROMPT CAPTION")=$PIECE(HFTEMP220,U,5)
+18 SET MEASDEF("UCUM DISPLAY")=$PIECE(HFTEMP220,U,6)
+19 IF '$$VALIDMEASDEF(.MEASDEF)
SET ^TMP("PXMEASDEF",$JOB,HFIEN)=""
End DoDot:2
+20 IF HFTEMP220=""
SET (MEASDEF("MIN"),MEASDEF("MAX"),MEASDEF("MAXDEC"),MEASDEF("UCUMIEN"),MEASDEF("PROMPT CAPTION"),MEASDEF("UCUM DISPLAY"))=""
+21 SET MEASDEF=$SELECT(MEASDEF("MIN")="":0,MEASDEF("MAX")="":0,1:1)
+22 SET VHFIEN=0
+23 FOR
SET VHFIEN=+$ORDER(^AUPNVHF("B",HFIEN,VHFIEN))
if VHFIEN=0
QUIT
Begin DoDot:2
+24 IF LCSHF
DO LCSHF(HFIEN,VHFIEN,.MEASDEF,.NUMREPAIRED)
QUIT
+25 SET VHFTEMP220=$GET(^AUPNVHF(VHFIEN,220))
+26 SET (MAGNITUDE,ORGMAG)=$PIECE(VHFTEMP220,U,1)
+27 SET UCUMIEN=$PIECE(VHFTEMP220,U,2)
+28 ;If the HF does not have a measurement defined delete the VHF 220 node.
+29 ;The 220 node could be ^.
+30 IF (MEASDEF=0)
IF ((MAGNITUDE'="")!(UCUMIEN'=""))
Begin DoDot:3
+31 SET ^AUPNVHF(VHFIEN,220)=""
SET NUMREPAIRED=NUMREPAIRED+1
End DoDot:3
QUIT
+32 IF (MAGNITUDE="")
IF (UCUMIEN="")
QUIT
+33 ;If the units do not match automatic repair is not posible.
+34 IF UCUMIEN'=MEASDEF("UCUMIEN")
SET ^TMP("PXNOREPAIR",$JOB,HFIEN,VHFIEN)=""
SET NUMNOTREPAIRED=NUMNOTREPAIRED+1
QUIT
+35 ;If MAGNITUDE is NULL try to get a number from COMMENTS.
+36 IF MAGNITUDE=""
Begin DoDot:3
+37 SET COMMENTS=$GET(^AUPNVHF(VHFIEN,811))
+38 IF COMMENTS=""
QUIT
+39 SET NUMBER=+COMMENTS
+40 SET VALIDNUM=$SELECT(NUMBER=COMMENTS:1,1:0)
+41 IF 'VALIDNUM
SET VALIDNUM=$$NUMCHECK(COMMENTS)
+42 IF 'VALIDNUM
QUIT
+43 IF (NUMBER<MEASDEF("MIN"))!(NUMBER>MEASDEF("MAX"))
QUIT
+44 SET MAGNITUDE=NUMBER
End DoDot:3
+45 ;Could not obtain a valid MAGNITUDE, remove anything on the 220 node.
+46 IF MAGNITUDE=""
Begin DoDot:3
+47 KILL ^AUPNVHF(VHFIEN,220)
+48 SET ^TMP("PXNOREPAIR",$JOB,HFIEN,VHFIEN)=""
SET NUMNOTREPAIRED=NUMNOTREPAIRED+1
End DoDot:3
QUIT
+49 IF (MAGNITUDE<MEASDEF("MIN"))!(MAGNITUDE>MEASDEF("MAX"))
Begin DoDot:3
+50 SET ^TMP("PXNOREPAIR",$JOB,HFIEN,VHFIEN)=""
SET NUMNOTREPAIRED=NUMNOTREPAIRED+1
End DoDot:3
QUIT
+51 ;Have a MAGNITUDE, make sure the number of decimals does not exceed MAXDEC.
+52 SET DEC=$PIECE(MAGNITUDE,".",2)
SET DECLEN=$LENGTH(DEC)
+53 IF DECLEN>MEASDEF("MAXDEC")
SET MAGNITUDE=$FNUMBER(MAGNITUDE,"",MEASDEF("MAXDEC"))
+54 IF MAGNITUDE'=ORGMAG
Begin DoDot:3
+55 SET ^AUPNVHF(VHFIEN,220)=MAGNITUDE_U_MEASDEF("UCUMIEN")
+56 SET NUMREPAIRED=NUMREPAIRED+1
End DoDot:3
End DoDot:2
End DoDot:1
+57 DO SENDVHFMESSAGE(NUMREPAIRED,NUMNOTREPAIRED)
+58 IF $DATA(^TMP("PXMEASDEF",$JOB))
DO SENDHFMESSAGE
+59 KILL ^TMP("PXMEASDEF",$JOB),^TMP("PXNOREPAIR",$JOB)
+60 QUIT
+61 ;
+62 ;===============================
SENDHFMESSAGE ;Send a MailMan message to the PCE Management Repair mail group
+1 ;listing the HF entries with incomplete measurement definitions.
+2 NEW HFIEN,MGIEN,MGROUP,NAME,NL,SUBJECT,TO,VALUE
+3 SET SUBJECT="HEALTH FACTORS WITH INCOMPLETE MEASUREMENT DEFINITION"
+4 SET MGIEN=+$GET(^PX(815,1,650))
+5 IF MGIEN>0
Begin DoDot:1
+6 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+7 SET TO(MGROUP)=""
End DoDot:1
+8 SET TO(DUZ)=""
+9 KILL ^TMP("PXHFMSG",$JOB)
+10 SET ^TMP("PXHFMSG",$JOB,1,0)="The following health factors have incomplete measurement definitions, they"
+11 SET ^TMP("PXHFMSG",$JOB,2,0)="should be completed as soon as possible."
+12 SET NL=2
+13 SET HFIEN=0
+14 FOR
SET HFIEN=$ORDER(^TMP("PXMEASDEF",$JOB,HFIEN))
if HFIEN=""
QUIT
Begin DoDot:1
+15 SET NAME=$PIECE(^AUTTHF(HFIEN,0),U,1)
+16 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=""
+17 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=NAME
+18 SET HFTEMP220=$GET(^AUTTHF(HFIEN,220))
+19 SET VALUE=$PIECE(HFTEMP220,U,1)
+20 IF VALUE=""
SET VALUE="Missing"
+21 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=" MINIMUM VALUE: "_VALUE
+22 SET VALUE=$PIECE(HFTEMP220,U,2)
+23 IF VALUE=""
SET VALUE="Missing"
+24 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=" MAXIMUM VALUE: "_VALUE
+25 SET VALUE=$PIECE(HFTEMP220,U,3)
+26 IF VALUE=""
SET VALUE="Missing"
+27 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=" MAXIMUM DECIMALS: "_VALUE
+28 SET VALUE=$PIECE(HFTEMP220,U,4)
+29 SET VALUE=$SELECT(VALUE'="":$$UCUMFIELDS^PXUCUM(VALUE,"DESCRIPTION"),1:"Missing")
+30 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=" UCUM CODE: "_VALUE
+31 SET VALUE=$PIECE(HFTEMP220,U,5)
+32 IF VALUE=""
SET VALUE="Missing"
+33 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=" PROMPT CAPTION: "_VALUE
+34 SET VALUE=$PIECE(HFTEMP220,U,6)
+35 IF VALUE=""
SET VALUE="Missing"
+36 SET NL=NL+1
SET ^TMP("PXHFMSG",$JOB,NL,0)=" UCUM DISPLAY: "_VALUE
End DoDot:1
+37 DO SEND^PXMSG("PXHFMSG",SUBJECT,.TO)
+38 KILL ^TMP("PXHFMSG",$JOB)
+39 QUIT
+40 ;
+41 ;===============================
SENDVHFMESSAGE(NUMREPAIRED,NUMNOTREPAIRED) ;Send a MailMan message to the PCE Management Repair mail group
+1 ;listing the VHF entries whose measurement could not be repaired.
+2 NEW DFN,HF,HFIEN,HFTEMP220,MAGNITUDE,MAX,MAXDEC,MGIEN,MGROUP,MIN,PATIENT,NL,NOW
+3 NEW SUBJECT,TEMP,TO,UCUMCODE,UCUMIEN,VHFIEN,VHFTEMP220,VISITDT,VISITIEN
+4 KILL ^TMP("PXVHFMSG",$JOB)
+5 SET SUBJECT="V HEALTH FACTORS MEASUREMENT REPAIR"
+6 SET MGIEN=+$GET(^PX(815,1,650))
+7 IF MGIEN>0
Begin DoDot:1
+8 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+9 SET TO(MGROUP)=""
End DoDot:1
+10 SET TO(DUZ)=""
+11 SET NOW=$$NOW^XLFDT
+12 SET ^TMP("PXVHFMSG",$JOB,1,0)="V HEALTH FACTORS measurement repair completed at "_$$FMTE^XLFDT(NOW)
+13 SET ^TMP("PXVHFMSG",$JOB,2,0)="Measurements were repaired for "_NUMREPAIRED_" entries."
+14 IF '$DATA(^TMP("PXNOREPAIR",$JOB))
Begin DoDot:1
+15 DO SEND^PXMSG("PXVHFMSG",SUBJECT,.TO)
+16 KILL ^TMP("PXVHFMSG",$JOB)
End DoDot:1
QUIT
+17 SET ^TMP("PXVHFMSG",$JOB,3,0)="There were "_NUMNOTREPAIRED_" V HEALTH FACTORS entries that could not be automatically"
+18 SET ^TMP("PXVHFMSG",$JOB,4,0)="repaired:"
+19 SET HFIEN=0
SET NL=4
+20 FOR
SET HFIEN=$ORDER(^TMP("PXNOREPAIR",$JOB,HFIEN))
if HFIEN=""
QUIT
Begin DoDot:1
+21 SET HF=$PIECE(^AUTTHF(HFIEN,0),U,1)
+22 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)=""
+23 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)="Health Factor: "_HF
+24 SET HFTEMP220=^AUTTHF(HFIEN,220)
+25 SET MIN=$PIECE(HFTEMP220,U,1)
+26 SET MAX=$PIECE(HFTEMP220,U,2)
+27 SET MAXDEC=$PIECE(HFTEMP220,U,3)
+28 SET UCUMIEN=$PIECE(HFTEMP220,U,4)
+29 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)="Minimum Value: "_MIN_" Maximum Value: "_MAX
+30 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)="Maximum Decimals: "_MAXDEC
+31 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)="UCUM Code: "_$$UCUMFIELDS^PXUCUM(UCUMIEN,"DESCRIPTION")
+32 SET VHFIEN=0
+33 FOR
SET VHFIEN=$ORDER(^TMP("PXNOREPAIR",$JOB,HFIEN,VHFIEN))
if VHFIEN=""
QUIT
Begin DoDot:2
+34 SET TEMP=^AUPNVHF(VHFIEN,0)
+35 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)=""
+36 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)=" V Health Factors IEN: "_VHFIEN
+37 SET DFN=$PIECE(TEMP,U,2)
SET PATIENT=$PIECE(^DPT(DFN,0),U,1)
+38 SET VISITIEN=$PIECE(TEMP,U,3)
SET VISITDT=$PIECE(^AUPNVSIT(VISITIEN,0),U,1)
+39 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)=" Visit: "_$$FMTE^XLFDT(VISITDT)
+40 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)=" Patient: "_PATIENT
+41 SET VHFTEMP220=$GET(^AUPNVHF(VHFIEN,220))
+42 SET MAGNITUDE=$PIECE(VHFTEMP220,U,1)
+43 IF MAGNITUDE=""
SET MAGNITUDE="Missing"
+44 SET UCUMIEN=$PIECE(VHFTEMP220,U,2)
+45 IF UCUMIEN>0
SET UCUMCODE=$$UCUMFIELDS^PXUCUM(UCUMIEN,"DESCRIPTION")
+46 IF '$TEST
SET UCUMCODE="Missing"
+47 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)=" MAGNITUDE: "_MAGNITUDE_"; UCUM CODE: "_UCUMCODE
+48 SET NL=NL+1
SET ^TMP("PXVHFMSG",$JOB,NL,0)=" Comments: "_$GET(^AUPNVHF(VHFIEN,811))
End DoDot:2
End DoDot:1
+49 DO SEND^PXMSG("PXVHFMSG",SUBJECT,.TO)
+50 KILL ^TMP("PXVHFMSG",$JOB)
+51 QUIT
+52 ;
+53 ;===============================
TASKREPAIR ;Run REPAIR^PXHFMEASREPAIR as a TaskMan job.
+1 NEW TEXT,ZTDTH,ZTSAVE,ZTIO,ZTSK,ZTRTN,ZTDESC,ZTUCI,ZTCPU,ZTSYNC,ZTKIL
+2 SET ZTRTN="REPAIR^PXHFMEASREPAIR"
+3 SET ZTDESC="Repair corrupted V HEALTH FACTORS measurements"
+4 SET ZTIO=""
+5 SET ZTDTH=$HOROLOG
+6 DO ^%ZTLOAD
+7 IF $GET(ZTSK)
Begin DoDot:1
+8 SET TEXT="V HEALTH FACTORS measurement repair has been queued, task number: "_ZTSK
+9 DO BMES^XPDUTL(.TEXT)
End DoDot:1
+10 IF '$GET(ZTSK)
Begin DoDot:1
+11 SET TEXT="V HEALTH FACTORS measurement repair failed to queue. Please create a ticket."
+12 DO BMES^XPDUTL(.TEXT)
End DoDot:1
+13 QUIT
+14 ;
+15 ;===============================
VALIDMEASDEF(MEASDEF) ;Make sure a measurement is completely defined.
+1 NEW NUMNULL
+2 SET NUMNULL=0
+3 IF MEASDEF("MIN")=""
SET NUMNULL=NUMNULL+1
+4 IF MEASDEF("MAX")=""
SET NUMNULL=NUMNULL+1
+5 IF MEASDEF("MAXDEC")=""
SET NUMNULL=NUMNULL+1
+6 IF MEASDEF("UCUMIEN")=""
SET NUMNULL=NUMNULL+1
+7 IF MEASDEF("PROMPT CAPTION")=""
SET NUMNULL=NUMNULL+1
+8 IF MEASDEF("UCUM DISPLAY")=""
SET NUMNULL=NUMNULL+1
+9 QUIT $SELECT(NUMNULL=0:1,1:0)
+10 ;
