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

VAQPST50.m

Go to the documentation of this file. 
  1. VAQPST50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT;28-APR-94
  1.  ;;1.5;PATIENT DATA EXCHANGE;**4**;NOV 17, 1993
  1. ADDSEG(HSPTR,MAXTIME,MAXOCCUR) ;ADD NEW DATA SEGMENT USING H.S. COMPONENT
  1.  ;INPUT  : HSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
  1.  ;         MAXTIME - Max time limit allowed for auto processing
  1.  ;         MAXOCCUR - Max occurrence limit allowed for auto processing
  1.  ;OUTPUT : X - Pointer to VAQ - DATA SEGMENT file (#394.71) that
  1.  ;             was created
  1.  ;        -1^ErrorText - Entry not created
  1.  ;NOTES  : If time and/or occurrence limits do not apply to the
  1.  ;         component, MAXTIME and/or MAXOCCUR are not required.
  1.  ;       : If time and/or occurrence limits apply to the component,
  1.  ;         default values will be taken from the VAQ - PARAMETER
  1.  ;         file (#394.81).  If parameter file does not contain these
  1.  ;         values, a default of 1 year and 10 occurrences will be used.
  1.  ;       : If a maximum limit is not valid, the default limit will
  1.  ;         be used.
  1.  ;
  1.  ;CHECK INPUT
  1.  S HSPTR=+$G(HSPTR)
  1.  Q:('HSPTR) "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
  1.  Q:('$D(^GMT(142.1,HSPTR,0))) "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
  1.  S MAXTIME=$G(MAXTIME)
  1.  S MAXOCCUR=$G(MAXOCCUR)
  1.  ;DECLARE VARIABLES
  1.  N NAME,ABB,TIME,OCCUR,TMP,DEFTIME,DEFOCCUR
  1.  N X,Y,DIC,DINUM,DA,DIE,DR
  1.  ;GET COMPONENT NAME & ABBREVIATION
  1.  S TMP=$G(^GMT(142.1,HSPTR,0))
  1.  S NAME=$P(TMP,"^",1)
  1.  Q:(NAME="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
  1.  S ABB=$P(TMP,"^",4)
  1.  Q:(ABB="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
  1.  ;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
  1.  S NAME=$$FIRSTUP(NAME)
  1.  ;SEE IF NAME OR ABBREVIATION ALREADY EXIST IN DATA SEGMENT FILE
  1.  Q:($D(^VAT(394.71,"B",NAME))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
  1.  Q:($D(^VAT(394.71,"CAPS",NAME))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
  1.  Q:($D(^VAT(394.71,"C",ABB))) "-1^Abbreviation of "_ABB_" already used in VAQ - DATA SEGMENT file"
  1.  ;GET DEFAULT TIME AND OCCURRENCE LIMITS
  1.  S X=+$O(^VAT(394.81,0))
  1.  S TMP=$G(^VAT(394.81,X,"LIMITS"))
  1.  S DEFTIME=$P(TMP,"^",1)
  1.  S:(DEFTIME="") DEFTIME="1Y"
  1.  S DEFOCCUR=$P(TMP,"^",2)
  1.  S:(DEFOCCUR="") DEFOCCUR=10
  1.  ;DETERMINE IF TIME AND/OR OCCURRENCE LIMITS APPLY
  1.  S TMP=$$LIMITS^VAQDBIH3(HSPTR)
  1.  S TIME=+TMP
  1.  S OCCUR=+$P(TMP,"^",2)
  1.  ;SET MAX LIMITS
  1.  I (TIME) S:($$VALOCC^VAQDBIH2(MAXTIME,0)<0) MAXTIME=DEFTIME
  1.  I ('TIME) S MAXTIME=""
  1.  I (OCCUR) S:($$VALOCC^VAQDBIH2(MAXOCCUR,1)<0) MAXOCCUR=DEFOCCUR
  1.  I ('OCCUR) S MAXOCCUR=""
  1.  ;SET UP CALL TO FILEMAN & CREATE STUB
  1.  K DD,DO
  1.  S DIC="^VAT(394.71,"
  1.  S DIC(0)="L"
  1.  S X=NAME
  1.  D FILE^DICN
  1.  S DA=+Y
  1.  Q:(DA<0) "-1^Unable to create entry in VAQ - DATA SEGMENT file"
  1.  ;SET UP CALL TO FILEMAN & FINISH ENTRY
  1.  S DIE="^VAT(394.71,"
  1.  S DR=".02///^S X=ABB"
  1.  S DR(1,394.71,.03)=".03///YES"
  1.  S DR(1,394.71,.04)=".04////"_HSPTR
  1.  S DR(1,394.71,.05)=".05///^S X=MAXTIME"
  1.  S DR(1,394.71,.06)=".06///^S X=MAXOCCUR"
  1.  S DR(1,394.71,10)="10///$$GET^GMTSPDX(TRAN,DFN,SEGPTR,ROOT,(OFFSET-1),TIMLIM,OCCLIM)"
  1.  S DR(1,394.71,20)="20///@"
  1.  D ^DIE
  1.  Q 0
  1. LOWER(STRING) ;CONVERT UPPERCASE TO LOWERCASE
  1.  ;INPUT  : STRING - Text string to convert
  1.  ;OUTPUT : string - Same text string in all lowercase
  1.  ;
  1.  Q $TR($G(STRING),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1. FIRSTUP(TEXT) ;FIRST CHARACTER EVERY WORD UPPER
  1.  ;INPUT  : TEXT - Text string to convert
  1.  ;OUTPUT : Text - Same text string with beginning of every word
  1.  ;                in uppercase and all other characters in lowercase
  1.  ;
  1.  ;CHECK INPUT
  1.  Q:($G(TEXT)="") ""
  1.  ;DECLARE VARIABLES
  1.  N OUTTEXT,SPOT,UPCHAR,X,Y,LEN
  1.  ;CONVERT TO LOWERCASE
  1.  S OUTTEXT=$$LOWER(TEXT)
  1.  ;CAPITALIZE FIRST WORD
  1.  S X=$E(OUTTEXT,1)
  1.  X ^%ZOSF("UPPERCASE")
  1.  S OUTTEXT=Y_$E(OUTTEXT,2,$L(OUTTEXT))
  1.  ;CAPITALIZE REST OF WORDS
  1.  S SPOT=1
  1.  S LEN=$L(OUTTEXT)
  1.  F  S SPOT=$F(OUTTEXT," ",SPOT) Q:('SPOT)  D
  1.  .S X=$E(OUTTEXT,SPOT)
  1.  .X ^%ZOSF("UPPERCASE")
  1.  .S OUTTEXT=$E(OUTTEXT,1,(SPOT-1))_Y_$E(OUTTEXT,(SPOT+1),LEN)
  1.  Q OUTTEXT