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

VAQUTL50.m

Go to the documentation of this file.
VAQUTL50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT;Jun 07, 2023@11:47
 ;;1.5;PATIENT DATA EXCHANGE;**11,46**;NOV 17, 1993;Build 17
 ; Reference to ^GMT(142.1,D0,0) in ICR #814
ADDSEG(HSPTR,MAXTIME,MAXOCCUR) ;ADD NEW DATA SEGMENT USING H.S. COMPONENT
 ;INPUT  : HSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
 ;         MAXTIME - Max time limit allowed for auto processing
 ;         MAXOCCUR - Max occurrence limit allowed for auto processing
 ;OUTPUT : 0 - VAQ - DATA SEGMENT file (#394.71) entry was successfully
 ;             created
 ;        -1^ErrorText - Entry not created
 ;NOTES  : If time and/or occurrence limits do not apply to the
 ;         component, MAXTIME and/or MAXOCCUR are not required.
 ;       : If time and/or occurrence limits apply to the component,
 ;         default values will be taken from the VAQ - PARAMETER
 ;         file (#394.81).  If parameter file does not contain these
 ;         values, a default of 1 year and 10 occurrences will be used.
 ;       : If a maximum limit is not valid, the default limit will
 ;         be used.
 ;
 ;CHECK INPUT
 S HSPTR=+$G(HSPTR)
 Q:('HSPTR) "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
 Q:('$D(^GMT(142.1,HSPTR,0))) "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
 S MAXTIME=$G(MAXTIME)
 S MAXOCCUR=$G(MAXOCCUR)
 ;DECLARE VARIABLES
 N NAME,ABB,TMP
 N X,Y,DIC,DINUM,DA,DIE,DR
 ;GET COMPONENT NAME & ABBREVIATION
 S TMP=$G(^GMT(142.1,HSPTR,0))
 S NAME=$P(TMP,U,1)
 Q:(NAME="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
 S ABB=$P(TMP,U,4)
 Q:(ABB="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
 ;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
 S NAME=$$FIRSTUP(NAME)
 ;SEE IF NAME OR ABBREVIATION ALREADY EXIST IN DATA SEGMENT FILE
 Q:($D(^VAT(394.71,"B",NAME))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
 Q:($D(^VAT(394.71,"CAPS",$$UP^XLFSTR(NAME)))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
 Q:($D(^VAT(394.71,"C",ABB))) "-1^Abbreviation of "_ABB_" already used in VAQ - DATA SEGMENT file"
 D LIMITS(HSPTR,.MAXTIME,.MAXOCCUR)
 ;SET UP CALL TO FILEMAN & CREATE STUB
 N VAQFDA,VAQERROR,VAQMESSAGE
 S VAQFDA(394.71,"+1,",.01)=NAME
 S VAQFDA(394.71,"+1,",.02)=ABB
 S VAQFDA(394.71,"+1,",.03)="YES"
 S VAQFDA(394.71,"+1,",.04)="`"_HSPTR
 S VAQFDA(394.71,"+1,",.05)=MAXTIME
 S VAQFDA(394.71,"+1,",.06)=MAXOCCUR
 S VAQFDA(394.71,"+1,",10)="$$GET^GMTSPDX(TRAN,DFN,SEGPTR,ROOT,(OFFSET-1),TIMLIM,OCCLIM)"
 S VAQFDA(394.71,"+1,",20)="@"
 D UPDATE^DIE("E","VAQFDA",,"VAQERROR")
 I $D(VAQERROR) D  Q "-1"_U_VAQMESSAGE
 .D MSG^DIALOG("AET",.VAQMESSAGE,,,"VAQERROR")
 .N VAQLINE
 .F VAQLINE=1:1:VAQMESSAGE  D
 ..S VAQERROR=$S($G(VAQERROR)'="":VAQERROR_" ",1:"")_VAQMESSAGE(VAQLINE)
 Q 0
LIMITS(VAQHSPTR,VAQMAXTIME,VAQMAXOCCUR) ;DETERMINE MAX TIME/OCCURRENCE LIMITS
 ;INPUT: VAQHSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
 ;       VAQMAXTIME - Max time limit allowed for auto processing
 ;       VQAMAXOCCUR - Max occurrence limit allowed for auto processing
 ;GET DEFAULT TIME AND OCCURRENCE LIMITS
 N VAQIEN,VAQNLIMIT,VAQDEFTIME,VAQDEFOCCUR,VAQLIMIT,VAQTIME,VAQOCCUR
 S VAQIEN=+$O(^VAT(394.81,0))
 S VAQNLIMIT=$G(^VAT(394.81,VAQIEN,"LIMITS"))
 S VAQDEFTIME=$P(VAQNLIMIT,U,1)
 S:(VAQDEFTIME="") VAQDEFTIME="1Y"
 S VAQDEFOCCUR=$P(VAQNLIMIT,U,2)
 S:(VAQDEFOCCUR="") VAQDEFOCCUR=10
 ;DETERMINE IF TIME AND/OR OCCURRENCE LIMITS APPLY
 S VAQLIMIT=$$LIMITS^VAQDBIH3(VAQHSPTR)
 S VAQTIME=+VAQLIMIT,VAQOCCUR=+$P(VAQLIMIT,U,2)
 ;SET MAX LIMITS
 I (VAQTIME) S:($$VALOCC^VAQDBIH2(VAQMAXTIME,0)<0) VAQMAXTIME=VAQDEFTIME
 I ('VAQTIME) S VAQMAXTIME=""
 I (VAQOCCUR) S:($$VALOCC^VAQDBIH2(VAQMAXOCCUR,1)<0) VAQMAXOCCUR=VAQDEFOCCUR
 I ('VAQOCCUR) S VAQMAXOCCUR=""
 Q
UPDSEG(VAQHSPTR,VAQMAXTIME,VAQMAXOCCUR) ;UPDATE EXISTING DATA SEGMENT USING H.S. COMPONENT
 ;INPUT  : VAQHSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
 ;         VAQMAXTIME - Max time limit allowed for auto processing
 ;         VAQMAXOCCUR - Max occurrence limit allowed for auto processing
 ;OUTPUT : $$UPDSEG - 0 - VAQ - DATA SEGMENT file (#394.71) entry was successfully
 ;                        updated
 ;        -1^ErrorText - Entry not updated
 ;NOTES  : If time and/or occurrence limits do not apply to the
 ;         component, MAXTIME and/or MAXOCCUR are not required.
 ;       : If time and/or occurrence limits apply to the component,
 ;         default values will be taken from the VAQ - PARAMETER
 ;         file (#394.81).  If parameter file does not contain these
 ;         values, a default of 1 year and 10 occurrences will be used.
 ;       : If a maximum limit is not valid, the default limit will
 ;         be used.
 ;CHECK INPUT
 S VAQHSPTR=+$G(VAQHSPTR)
 Q:('VAQHSPTR) "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
 Q:('$D(^GMT(142.1,VAQHSPTR,0))) "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
 S VAQMAXTIME=$G(VAQMAXTIME)
 S VAQMAXOCCUR=$G(VAQMAXOCCUR)
 N VAQGMTSN0,VAQNAME,VAQABB,VAQIEN,VAQREC,VAQFDA,VAQERROR,VAQMESSAGE,VAQLINE
 ;FIND THE EXISTING SEGMENT
 ;GET COMPONENT NAME & ABBREVIATION
 S VAQGMTSN0=$G(^GMT(142.1,VAQHSPTR,0))
 S VAQNAME=$P(VAQGMTSN0,U,1)
 Q:(VAQNAME="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
 S VAQABB=$P(VAQGMTSN0,U,4)
 Q:(VAQABB="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
 ;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
 S VAQNAME=$$FIRSTUP(VAQNAME)
 ;FIND EXISTING SEGMENT BY NAME, THEN BY ABBREVIATION, THEN BY POINTER TO
 ;HEALTH SUMMARY COMPONENT
 S VAQIEN=+$O(^VAT(394.71,"B",VAQNAME,0))
 I VAQIEN=0 S VAQIEN=+$O(^VAT(394.71,"CAPS",$$UP^XLFSTR(VAQNAME),0))
 I VAQIEN=0 S VAQIEN=+$O(^VAT(394.71,"C",VAQABB,0))
 I VAQIEN>0,$P($G(^VAT(394.71,VAQIEN,0)),U,4)'=VAQHSPTR S VAQIEN=0
 I VAQIEN=0 D
 .S VAQREC=0 F  S VAQREC=$O(^VAT(394.71,VAQREC)) Q:'+VAQREC!(VAQIEN>0)  D
 ..I $P(^VAT(394.71,VAQREC,0),U,4)=VAQHSPTR S VAQIEN=VAQREC Q
 Q:VAQIEN=0 "-1^"_VAQNAME_" was not found in the VAQ - DATA SEGMENT file"
 ;CHECK FOR NEW NAME & ABBREVIATION
 S VAQIEN=VAQIEN_","
 I VAQNAME'=$P($G(^VAT(394.71,+VAQIEN,0)),U,1) S VAQFDA(394.71,VAQIEN,.01)=VAQNAME
 I VAQABB'=$P($G(^VAT(394.71,+VAQIEN,0)),U,2) S VAQFDA(394.71,VAQIEN,.02)=VAQABB
 D LIMITS(VAQHSPTR,.VAQMAXTIME,.VAQMAXOCCUR)
 I VAQMAXTIME'=$P($G(^VAT(394.71,+VAQIEN,0)),U,5) S VAQFDA(394.71,VAQIEN,.05)=VAQMAXTIME
 I VAQMAXOCCUR'=$P($G(^VAT(394.71,+VAQIEN,0)),U,6) S VAQFDA(394.71,VAQIEN,.06)=VAQMAXOCCUR
 I $D(VAQFDA) D  Q:$D(VAQERROR) "-1"_U_VAQERROR
 .;USE FILEMAN TO UPDATE SEGMENT
 .D FILE^DIE("","VAQFDA","VAQERROR")
 .I $D(VAQERROR) D
 ..D MSG^DIALOG("AET",.VAQMESSAGE,,,"VAQERROR")
 ..F VAQLINE=1:1:VAQMESSAGE  D
 ...S VAQERROR=$S($G(VAQERROR)'="":VAQERROR_" ",1:"")_VAQMESSAGE(VAQLINE)
 Q 0
FIRSTUP(TEXT) ;FIRST CHARACTER EVERY WORD UPPER
 ;INPUT  : TEXT - Text string to convert
 ;OUTPUT : Text - Same text string with beginning of every word
 ;                in uppercase and all other characters in lowercase
 ;
 ;CHECK INPUT
 Q:($G(TEXT)="") ""
 ;DECLARE VARIABLES
 N OUTTEXT,SPOT,UPCHAR,X,Y,LEN
 ;CONVERT TO LOWERCASE
 S OUTTEXT=$$LOW^XLFSTR(TEXT)
 ;CAPITALIZE FIRST WORD
 S X=$E(OUTTEXT,1)
 X ^%ZOSF("UPPERCASE")
 S OUTTEXT=Y_$E(OUTTEXT,2,$L(OUTTEXT))
 ;CAPITALIZE REST OF WORDS
 S SPOT=1
 S LEN=$L(OUTTEXT)
 F  S SPOT=$F(OUTTEXT," ",SPOT) Q:('SPOT)  D
 .S X=$E(OUTTEXT,SPOT)
 .X ^%ZOSF("UPPERCASE")
 .S OUTTEXT=$E(OUTTEXT,1,(SPOT-1))_Y_$E(OUTTEXT,(SPOT+1),LEN)
 Q OUTTEXT