- 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 Jan 18, 2025@03:30: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 ;