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

VAQUTL1.m

Go to the documentation of this file.
  1. VAQUTL1 ;ALB/JRP - UTILITY ROUTINES;30-APR-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. REPEAT(CHAR,TIMES) ;REPEAT A STRING
  1. ;INPUT : CHAR - Character to repeat
  1. ; TIMES - Number of times to repeat CHAR
  1. ;OUTPUT : s - String of CHAR that is TIMES long
  1. ; "" - Error (bad input)
  1. ;
  1. ;CHECK INPUT
  1. Q:($G(CHAR)="") ""
  1. Q:((+$G(TIMES))=0) ""
  1. ;RETURN STRING
  1. Q $TR($J("",TIMES)," ",CHAR)
  1. INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;INSERT A STRING INTO ANOTHER
  1. ;INPUT : INSTR - String to insert
  1. ; OUTSTR - String to insert into
  1. ; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
  1. ; LENGTH - Number of characters to clear from OUTSTR
  1. ; (defaults to length of INSTR)
  1. ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
  1. ; using LENGTH characters
  1. ; "" - Error (bad input)
  1. ;
  1. ;NOTE : This module is based on $$SETSTR^VALM1
  1. ;
  1. ;CHECK INPUT
  1. Q:('$D(INSTR)) ""
  1. Q:('$D(OUTSTR)) ""
  1. S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
  1. S:('$D(LENGTH)) LENGTH=$L(INSTR)
  1. ;DECLARE VARIABLES
  1. N FRONT,END
  1. S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
  1. S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
  1. ;INSERT STRING
  1. Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
  1. KILLARR(ARRAY,NODE,START,END) ;KILL NODES OF AN ARRAY
  1. ;INPUT : ARRAY - Array to kill nodes in (full global reference)
  1. ; NODE - Subscript to kill (optional)
  1. ; START - Subscript to start killing at (default to first)
  1. ; END - Subscript to stop killing at (default to all)
  1. ;OUTPUT : 0 - Success
  1. ; -1 - Error
  1. ;
  1. ;NOTES:
  1. ; If NODE is passed KILLing takes place at
  1. ; @ARRAY@(NODE,x)
  1. ; If NODE is not passed KILLing takes place at
  1. ; @ARRAY@(x)
  1. ;
  1. ; If START is passed KILLing starts at
  1. ; @ARRAY@([NODE,]START)
  1. ; If START is not passed KILLing starts on first node after
  1. ; @ARRAY@([NODE,],"")
  1. ;
  1. ; If END is passed KILLing ends on first node after
  1. ; @ARRAR@([NODE,],END)
  1. ; If END is not passed KILLing ends on first node after
  1. ; @ARRAY@([NODE])
  1. ;CHECK INPUT
  1. Q:($G(ARRAY)="") -1
  1. S NODE=$G(NODE)
  1. S START=$G(START)
  1. S END=$G(END)
  1. ;DECLARE VARIABLES
  1. N LOOP,SUBSCRPT
  1. ;KILL STARTING SUBSCRIPT
  1. I (START'="")&(NODE'="") K @ARRAY@(NODE,START)
  1. I (START'="")&(NODE="") K @ARRAY@(START)
  1. ;KILL NODES
  1. F LOOP=0:0 D Q:(SUBSCRPT="")
  1. .I (NODE="") S SUBSCRPT=$O(@ARRAY@(START))
  1. .I (NODE'="") S SUBSCRPT=$O(@ARRAY@(NODE,START))
  1. .Q:(SUBSCRPT="")
  1. .I (NODE="") K @ARRAY@(SUBSCRPT)
  1. .I (NODE'="") K @ARRAY@(NODE,SUBSCRPT)
  1. .S:(SUBSCRPT=END) SUBSCRPT=""
  1. Q 0
  1. PATINFO(DFN) ;RETURNS PATIENT NAME, SSN, DOB, PATIENT ID
  1. ;INPUT : DFN - Pointer to patient in PATIENT file
  1. ;OUTPUT : Name^SSN^DOB^PID - Success
  1. ; -1^Error_Text - Error
  1. ;NOTES : SSN returned without dashes
  1. ; DOB returned in external format
  1. ;
  1. ;CHECK INPUT
  1. S DFN=+$G(DFN)
  1. Q:('DFN) "-1^Pointer to PATIENT file not passed"
  1. ;DECLARE VARIABLES
  1. N VAPTYP,VAHOW,VAROOT,VAERR,VA,TMP,Y,%DT
  1. S VAHOW=2
  1. K ^UTILITY("VADM",$J)
  1. D DEM^VADPT
  1. Q:(VAERR) "-1^Unable to gather patient information"
  1. S TMP=^UTILITY("VADM",$J,1)
  1. S $P(TMP,"^",2)=$P(^UTILITY("VADM",$J,2),"^",1)
  1. S Y=+^UTILITY("VADM",$J,3) D DD^%DT S $P(TMP,"^",3)=Y
  1. S $P(TMP,"^",4)=VA("PID")
  1. K ^UTILITY("VADM",$J)
  1. Q TMP
  1. ;
  1. PDXVER() ;RETURN VERSION OF PDX IN USE
  1. ;INPUT : None
  1. ;OUTPUT : N - Version of PDX in use at facility
  1. ; -1^Error_Text - Error
  1. ;
  1. ;DECLARE VARIABLES
  1. N X,Y
  1. S X=+$G(^DD(394.61,0,"VR"))
  1. S Y=$D(^DD(394))
  1. ;NOT INSTALLED
  1. Q:(('X)&('Y)) "-1^PDX has not been installed"
  1. ;VERSION 1.0
  1. Q:(('X)&(Y)) "1.0"
  1. ;VERSION 1.5 AND UP
  1. Q X
  1. ;
  1. APDX ;CONTINUATION OF APDX X-REF ON *PDX TRANSACTION FILE (# 394)
  1. ; THIS IS LEFT OVER FROM VERSION 1.0 - INCLUDED TO PASS %INDEX
  1. S:($P(^VAT(394,DA,0),U,12)=VAQ15)!($P(^(0),U,12)=VAQ16) ^VAT(394,"APDX",$P(^(0),U,4),X,(9999999.999999-$P(^(0),U,1)),DA)=""
  1. K:VAQTMP=1 VAQ15,VAQ16 K VAQTMP
  1. Q