Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXMEASUREMENT

PXMEASUREMENT.m

Go to the documentation of this file.
  1. PXMEASUREMENT ;SLC/PKR - Routines for measurements. ;04/28/2022
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
  1. ;
  1. ;==========
  1. FIXCMEAS ;Fix V EXAM,V HEALTH FACTORS, and V PATIENT ED entries that have a MAGNITUDE
  1. ;of 0 and no UCUM CODE.
  1. N IEN,MAG,NEDU,NEXAM,NHF,NODE,SUBJECT,TEMP220,UCUM
  1. S (NEDU,NEXAM,NHF)=0
  1. S IEN=0
  1. F S IEN=+$O(^AUPNVHF(IEN)) Q:IEN=0 D
  1. . S TEMP220=$G(^AUPNVHF(IEN,220))
  1. . S MAG=$P(TEMP220,U,1),UCUM=$P(TEMP220,U,2)
  1. . I ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'="")) D
  1. .. S NHF=NHF+1
  1. .. S ^AUPNVHF(IEN,220)=""
  1. ;
  1. S IEN=0
  1. F S IEN=+$O(^AUPNVPED(IEN)) Q:IEN=0 D
  1. . S TEMP220=$G(^AUPNVPED(IEN,220))
  1. . S MAG=$P(TEMP220,U,1),UCUM=$P(TEMP220,U,2)
  1. . I ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'="")) D
  1. .. S NEDU=NEDU+1
  1. .. S ^AUPNVPED(IEN,220)=""
  1. ;
  1. S IEN=0
  1. F S IEN=+$O(^AUPNVXAM(IEN)) Q:IEN=0 D
  1. . S TEMP220=$G(^AUPNVXAM(IEN,220))
  1. . S MAG=$P(TEMP220,U,1),UCUM=$P(TEMP220,U,2)
  1. . I ((MAG=0)&(UCUM=""))!((MAG="")&(UCUM'="")) D
  1. .. S NEXAM=NEXAM+1
  1. .. S ^AUPNVXAM(IEN,220)=""
  1. ;
  1. S NODE="PXXMZ"
  1. S SUBJECT="Corrupted Measurement Repair"
  1. K ^TMP(NODE,$J)
  1. S ^TMP(NODE,$J,1,0)=NHF_" V HEALTH FACTOR entries were repaired."
  1. S ^TMP(NODE,$J,2,0)=NEDU_" V PATIENT ED entries were repaired."
  1. S ^TMP(NODE,$J,3,0)=NEXAM_" V EXAM entries were repaired."
  1. S ^TMP(NODE,$J,4,0)="No further action is needed."
  1. D SEND^PXMSG(NODE,SUBJECT)
  1. K ^TMP(NODE,$J)
  1. Q
  1. ;
  1. ;==========
  1. MAGFORMAT(MAG) ;Format magnitude.
  1. ;Remove unneeded starting +.
  1. I $E(MAG,1)="+" S MAG=$E(MAG,2,25)
  1. ;If the magnitude is a fraction, make sure it is preceded by 0.
  1. I (MAG*MAG)<1 D
  1. . I $E(MAG,1)="." S MAG=0_MAG Q
  1. . I $E(MAG,1,2)="-." S MAG="-0"_$E(MAG,2,25) Q
  1. . I $E(MAG,1,2)="+." S MAG=0_$E(MAG,2,25) Q
  1. . I MAG="-0" S MAG=0
  1. Q MAG
  1. ;
  1. ;==========
  1. MAXDECEX(MAG,MAXDEC) ;^DIR does not recognize trailing 0s when checking the
  1. ;number of decimals. Use this as a screen to recognize
  1. ;trailing 0s when checking the number of decimals.
  1. N FRAC,LENFRAC
  1. S FRAC=$P(MAG,".",2)
  1. S LENFRAC=$L(FRAC)
  1. Q $S(LENFRAC>MAXDEC:1,1:0)
  1. ;
  1. ;==========
  1. TFIXCMEAS(START) ;Run FIXCMEAS^PXMEASUREMENT as a TaskMan job.
  1. S ZTRTN="FIXCMEAS^PXMEASUREMENT"
  1. S ZTDESC="Corrupted V-File measurement repair."
  1. S ZTIO=""
  1. S ZTDTH=$G(START)
  1. D ^%ZTLOAD
  1. D BMES^XPDUTL("TaskMan job: ZTSK="_ZTSK)
  1. Q
  1. ;
  1. ;==========
  1. UCDHTEXT ;UCUM DISPLAY executable help text.
  1. ;;This field specifies how the units are presented when a measurement is
  1. ;;displayed in CPRS, Clinical Reminders, and Health Summary. When the value
  1. ;;is C, the UCUM Code is displayed when the value is D, the Description is
  1. ;;displayed. When the value is N, no units are displayed.
  1. ;;**End Text**
  1. Q
  1. ;
  1. ;==========
  1. UCDXHELP(FILENUM,DA) ;UCUM DISPLAY executable help.
  1. N DONE,DIR0,IND,TEXT,UCUMDATA,UCUMIEN
  1. S DONE=0
  1. F IND=1:1 Q:DONE D
  1. . S TEXT(IND)=$P($T(UCDHTEXT+IND),";",3)
  1. . I TEXT(IND)="**End Text**" S TEXT(IND)=" ",DONE=1 Q
  1. S IND=IND-1
  1. ;
  1. ;Get the Description and UCUM Code.
  1. S UCUMIEN=$$GET^DDSVAL(FILENUM,DA,223)
  1. I UCUMIEN="" D
  1. . S IND=IND+1,TEXT(IND)="No units have been choosen yet, once they have, the Description and UCUM Code"
  1. . S IND=IND+1,TEXT(IND)="can be displayed to help you decide which to use."
  1. E D
  1. . D UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
  1. . S IND=IND+1,TEXT(IND)="The UCUM CODE is: "_UCUMDATA(UCUMIEN,"UCUM CODE")
  1. . S IND=IND+1,TEXT(IND)="The description is: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
  1. ;
  1. D BROWSE^DDBR("TEXT","NR","UCUM DISPLAY field Help")
  1. I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
  1. Q
  1. ;