PXMEASUREMENT ;SLC/PKR - Routines for measurements. ;04/28/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;==========
FIXCMEAS ;Fix V EXAM,V HEALTH FACTORS, and V PATIENT ED entries that have a MAGNITUDE
;of 0 and no UCUM CODE.
N IEN,MAG,NEDU,NEXAM,NHF,NODE,SUBJECT,TEMP220,UCUM
S (NEDU,NEXAM,NHF)=0
S IEN=0
F S IEN=+$O(^AUPNVHF(IEN)) Q:IEN=0 D
. S TEMP220=$G(^AUPNVHF(IEN,220))
. S MAG=$P(TEMP220,U,1),UCUM=$P(TEMP220,U,2)
. I ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'="")) D
.. S NHF=NHF+1
.. S ^AUPNVHF(IEN,220)=""
;
S IEN=0
F S IEN=+$O(^AUPNVPED(IEN)) Q:IEN=0 D
. S TEMP220=$G(^AUPNVPED(IEN,220))
. S MAG=$P(TEMP220,U,1),UCUM=$P(TEMP220,U,2)
. I ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'="")) D
.. S NEDU=NEDU+1
.. S ^AUPNVPED(IEN,220)=""
;
S IEN=0
F S IEN=+$O(^AUPNVXAM(IEN)) Q:IEN=0 D
. S TEMP220=$G(^AUPNVXAM(IEN,220))
. S MAG=$P(TEMP220,U,1),UCUM=$P(TEMP220,U,2)
. I ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'="")) D
.. S NEXAM=NEXAM+1
.. S ^AUPNVXAM(IEN,220)=""
;
S NODE="PXXMZ"
S SUBJECT="Corrupted Measurement Repair"
K ^TMP(NODE,$J)
S ^TMP(NODE,$J,1,0)=NHF_" V HEALTH FACTOR entries were repaired."
S ^TMP(NODE,$J,2,0)=NEDU_" V PATIENT ED entries were repaired."
S ^TMP(NODE,$J,3,0)=NEXAM_" V EXAM entries were repaired."
S ^TMP(NODE,$J,4,0)="No further action is needed."
D SEND^PXMSG(NODE,SUBJECT)
K ^TMP(NODE,$J)
Q
;
;==========
MAGFORMAT(MAG) ;Format magnitude.
;Remove unneeded starting +.
I $E(MAG,1)="+" S MAG=$E(MAG,2,25)
;If the magnitude is a fraction, make sure it is preceded by 0.
I (MAG*MAG)<1 D
. I $E(MAG,1)="." S MAG=0_MAG Q
. I $E(MAG,1,2)="-." S MAG="-0"_$E(MAG,2,25) Q
. I $E(MAG,1,2)="+." S MAG=0_$E(MAG,2,25) Q
. I MAG="-0" S MAG=0
Q MAG
;
;==========
MAXDECEX(MAG,MAXDEC) ;^DIR does not recognize trailing 0s when checking the
;number of decimals. Use this as a screen to recognize
;trailing 0s when checking the number of decimals.
N FRAC,LENFRAC
S FRAC=$P(MAG,".",2)
S LENFRAC=$L(FRAC)
Q $S(LENFRAC>MAXDEC:1,1:0)
;
;==========
TFIXCMEAS(START) ;Run FIXCMEAS^PXMEASUREMENT as a TaskMan job.
S ZTRTN="FIXCMEAS^PXMEASUREMENT"
S ZTDESC="Corrupted V-File measurement repair."
S ZTIO=""
S ZTDTH=$G(START)
D ^%ZTLOAD
D BMES^XPDUTL("TaskMan job: ZTSK="_ZTSK)
Q
;
;==========
UCDHTEXT ;UCUM DISPLAY executable help text.
;;This field specifies how the units are presented when a measurement is
;;displayed in CPRS, Clinical Reminders, and Health Summary. When the value
;;is C, the UCUM Code is displayed when the value is D, the Description is
;;displayed. When the value is N, no units are displayed.
;;**End Text**
Q
;
;==========
UCDXHELP(FILENUM,DA) ;UCUM DISPLAY executable help.
N DONE,DIR0,IND,TEXT,UCUMDATA,UCUMIEN
S DONE=0
F IND=1:1 Q:DONE D
. S TEXT(IND)=$P($T(UCDHTEXT+IND),";",3)
. I TEXT(IND)="**End Text**" S TEXT(IND)=" ",DONE=1 Q
S IND=IND-1
;
;Get the Description and UCUM Code.
S UCUMIEN=$$GET^DDSVAL(FILENUM,DA,223)
I UCUMIEN="" D
. S IND=IND+1,TEXT(IND)="No units have been choosen yet, once they have, the Description and UCUM Code"
. S IND=IND+1,TEXT(IND)="can be displayed to help you decide which to use."
E D
. D UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
. S IND=IND+1,TEXT(IND)="The UCUM CODE is: "_UCUMDATA(UCUMIEN,"UCUM CODE")
. S IND=IND+1,TEXT(IND)="The description is: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
;
D BROWSE^DDBR("TEXT","NR","UCUM DISPLAY field Help")
I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXMEASUREMENT 3604 printed Sep 23, 2025@20:05:43 Page 2
PXMEASUREMENT ;SLC/PKR - Routines for measurements. ;04/28/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ;==========
FIXCMEAS ;Fix V EXAM,V HEALTH FACTORS, and V PATIENT ED entries that have a MAGNITUDE
+1 ;of 0 and no UCUM CODE.
+2 NEW IEN,MAG,NEDU,NEXAM,NHF,NODE,SUBJECT,TEMP220,UCUM
+3 SET (NEDU,NEXAM,NHF)=0
+4 SET IEN=0
+5 FOR
SET IEN=+$ORDER(^AUPNVHF(IEN))
if IEN=0
QUIT
Begin DoDot:1
+6 SET TEMP220=$GET(^AUPNVHF(IEN,220))
+7 SET MAG=$PIECE(TEMP220,U,1)
SET UCUM=$PIECE(TEMP220,U,2)
+8 IF ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'=""))
Begin DoDot:2
+9 SET NHF=NHF+1
+10 SET ^AUPNVHF(IEN,220)=""
End DoDot:2
End DoDot:1
+11 ;
+12 SET IEN=0
+13 FOR
SET IEN=+$ORDER(^AUPNVPED(IEN))
if IEN=0
QUIT
Begin DoDot:1
+14 SET TEMP220=$GET(^AUPNVPED(IEN,220))
+15 SET MAG=$PIECE(TEMP220,U,1)
SET UCUM=$PIECE(TEMP220,U,2)
+16 IF ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'=""))
Begin DoDot:2
+17 SET NEDU=NEDU+1
+18 SET ^AUPNVPED(IEN,220)=""
End DoDot:2
End DoDot:1
+19 ;
+20 SET IEN=0
+21 FOR
SET IEN=+$ORDER(^AUPNVXAM(IEN))
if IEN=0
QUIT
Begin DoDot:1
+22 SET TEMP220=$GET(^AUPNVXAM(IEN,220))
+23 SET MAG=$PIECE(TEMP220,U,1)
SET UCUM=$PIECE(TEMP220,U,2)
+24 IF ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'=""))
Begin DoDot:2
+25 SET NEXAM=NEXAM+1
+26 SET ^AUPNVXAM(IEN,220)=""
End DoDot:2
End DoDot:1
+27 ;
+28 SET NODE="PXXMZ"
+29 SET SUBJECT="Corrupted Measurement Repair"
+30 KILL ^TMP(NODE,$JOB)
+31 SET ^TMP(NODE,$JOB,1,0)=NHF_" V HEALTH FACTOR entries were repaired."
+32 SET ^TMP(NODE,$JOB,2,0)=NEDU_" V PATIENT ED entries were repaired."
+33 SET ^TMP(NODE,$JOB,3,0)=NEXAM_" V EXAM entries were repaired."
+34 SET ^TMP(NODE,$JOB,4,0)="No further action is needed."
+35 DO SEND^PXMSG(NODE,SUBJECT)
+36 KILL ^TMP(NODE,$JOB)
+37 QUIT
+38 ;
+39 ;==========
MAGFORMAT(MAG) ;Format magnitude.
+1 ;Remove unneeded starting +.
+2 IF $EXTRACT(MAG,1)="+"
SET MAG=$EXTRACT(MAG,2,25)
+3 ;If the magnitude is a fraction, make sure it is preceded by 0.
+4 IF (MAG*MAG)<1
Begin DoDot:1
+5 IF $EXTRACT(MAG,1)="."
SET MAG=0_MAG
QUIT
+6 IF $EXTRACT(MAG,1,2)="-."
SET MAG="-0"_$EXTRACT(MAG,2,25)
QUIT
+7 IF $EXTRACT(MAG,1,2)="+."
SET MAG=0_$EXTRACT(MAG,2,25)
QUIT
+8 IF MAG="-0"
SET MAG=0
End DoDot:1
+9 QUIT MAG
+10 ;
+11 ;==========
MAXDECEX(MAG,MAXDEC) ;^DIR does not recognize trailing 0s when checking the
+1 ;number of decimals. Use this as a screen to recognize
+2 ;trailing 0s when checking the number of decimals.
+3 NEW FRAC,LENFRAC
+4 SET FRAC=$PIECE(MAG,".",2)
+5 SET LENFRAC=$LENGTH(FRAC)
+6 QUIT $SELECT(LENFRAC>MAXDEC:1,1:0)
+7 ;
+8 ;==========
TFIXCMEAS(START) ;Run FIXCMEAS^PXMEASUREMENT as a TaskMan job.
+1 SET ZTRTN="FIXCMEAS^PXMEASUREMENT"
+2 SET ZTDESC="Corrupted V-File measurement repair."
+3 SET ZTIO=""
+4 SET ZTDTH=$GET(START)
+5 DO ^%ZTLOAD
+6 DO BMES^XPDUTL("TaskMan job: ZTSK="_ZTSK)
+7 QUIT
+8 ;
+9 ;==========
UCDHTEXT ;UCUM DISPLAY executable help text.
+1 ;;This field specifies how the units are presented when a measurement is
+2 ;;displayed in CPRS, Clinical Reminders, and Health Summary. When the value
+3 ;;is C, the UCUM Code is displayed when the value is D, the Description is
+4 ;;displayed. When the value is N, no units are displayed.
+5 ;;**End Text**
+6 QUIT
+7 ;
+8 ;==========
UCDXHELP(FILENUM,DA) ;UCUM DISPLAY executable help.
+1 NEW DONE,DIR0,IND,TEXT,UCUMDATA,UCUMIEN
+2 SET DONE=0
+3 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+4 SET TEXT(IND)=$PIECE($TEXT(UCDHTEXT+IND),";",3)
+5 IF TEXT(IND)="**End Text**"
SET TEXT(IND)=" "
SET DONE=1
QUIT
End DoDot:1
+6 SET IND=IND-1
+7 ;
+8 ;Get the Description and UCUM Code.
+9 SET UCUMIEN=$$GET^DDSVAL(FILENUM,DA,223)
+10 IF UCUMIEN=""
Begin DoDot:1
+11 SET IND=IND+1
SET TEXT(IND)="No units have been choosen yet, once they have, the Description and UCUM Code"
+12 SET IND=IND+1
SET TEXT(IND)="can be displayed to help you decide which to use."
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 DO UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
+15 SET IND=IND+1
SET TEXT(IND)="The UCUM CODE is: "_UCUMDATA(UCUMIEN,"UCUM CODE")
+16 SET IND=IND+1
SET TEXT(IND)="The description is: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
End DoDot:1
+17 ;
+18 DO BROWSE^DDBR("TEXT","NR","UCUM DISPLAY field Help")
+19 IF $DATA(DDS)
DO REFRESH^DDSUTL
SET DY=IOSL-7
SET DX=0
XECUTE IOXY
SET $Y=DY
SET $X=DX
+20 QUIT
+21 ;
