source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQUTL1.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1VAQUTL1 ;ALB/JRP - UTILITY ROUTINES;30-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3REPEAT(CHAR,TIMES) ;REPEAT A STRING
4 ;INPUT : CHAR - Character to repeat
5 ; TIMES - Number of times to repeat CHAR
6 ;OUTPUT : s - String of CHAR that is TIMES long
7 ; "" - Error (bad input)
8 ;
9 ;CHECK INPUT
10 Q:($G(CHAR)="") ""
11 Q:((+$G(TIMES))=0) ""
12 ;RETURN STRING
13 Q $TR($J("",TIMES)," ",CHAR)
14INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;INSERT A STRING INTO ANOTHER
15 ;INPUT : INSTR - String to insert
16 ; OUTSTR - String to insert into
17 ; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
18 ; LENGTH - Number of characters to clear from OUTSTR
19 ; (defaults to length of INSTR)
20 ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
21 ; using LENGTH characters
22 ; "" - Error (bad input)
23 ;
24 ;NOTE : This module is based on $$SETSTR^VALM1
25 ;
26 ;CHECK INPUT
27 Q:('$D(INSTR)) ""
28 Q:('$D(OUTSTR)) ""
29 S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
30 S:('$D(LENGTH)) LENGTH=$L(INSTR)
31 ;DECLARE VARIABLES
32 N FRONT,END
33 S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
34 S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
35 ;INSERT STRING
36 Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
37KILLARR(ARRAY,NODE,START,END) ;KILL NODES OF AN ARRAY
38 ;INPUT : ARRAY - Array to kill nodes in (full global reference)
39 ; NODE - Subscript to kill (optional)
40 ; START - Subscript to start killing at (default to first)
41 ; END - Subscript to stop killing at (default to all)
42 ;OUTPUT : 0 - Success
43 ; -1 - Error
44 ;
45 ;NOTES:
46 ; If NODE is passed KILLing takes place at
47 ; @ARRAY@(NODE,x)
48 ; If NODE is not passed KILLing takes place at
49 ; @ARRAY@(x)
50 ;
51 ; If START is passed KILLing starts at
52 ; @ARRAY@([NODE,]START)
53 ; If START is not passed KILLing starts on first node after
54 ; @ARRAY@([NODE,],"")
55 ;
56 ; If END is passed KILLing ends on first node after
57 ; @ARRAR@([NODE,],END)
58 ; If END is not passed KILLing ends on first node after
59 ; @ARRAY@([NODE])
60 ;CHECK INPUT
61 Q:($G(ARRAY)="") -1
62 S NODE=$G(NODE)
63 S START=$G(START)
64 S END=$G(END)
65 ;DECLARE VARIABLES
66 N LOOP,SUBSCRPT
67 ;KILL STARTING SUBSCRIPT
68 I (START'="")&(NODE'="") K @ARRAY@(NODE,START)
69 I (START'="")&(NODE="") K @ARRAY@(START)
70 ;KILL NODES
71 F LOOP=0:0 D Q:(SUBSCRPT="")
72 .I (NODE="") S SUBSCRPT=$O(@ARRAY@(START))
73 .I (NODE'="") S SUBSCRPT=$O(@ARRAY@(NODE,START))
74 .Q:(SUBSCRPT="")
75 .I (NODE="") K @ARRAY@(SUBSCRPT)
76 .I (NODE'="") K @ARRAY@(NODE,SUBSCRPT)
77 .S:(SUBSCRPT=END) SUBSCRPT=""
78 Q 0
79PATINFO(DFN) ;RETURNS PATIENT NAME, SSN, DOB, PATIENT ID
80 ;INPUT : DFN - Pointer to patient in PATIENT file
81 ;OUTPUT : Name^SSN^DOB^PID - Success
82 ; -1^Error_Text - Error
83 ;NOTES : SSN returned without dashes
84 ; DOB returned in external format
85 ;
86 ;CHECK INPUT
87 S DFN=+$G(DFN)
88 Q:('DFN) "-1^Pointer to PATIENT file not passed"
89 ;DECLARE VARIABLES
90 N VAPTYP,VAHOW,VAROOT,VAERR,VA,TMP,Y,%DT
91 S VAHOW=2
92 K ^UTILITY("VADM",$J)
93 D DEM^VADPT
94 Q:(VAERR) "-1^Unable to gather patient information"
95 S TMP=^UTILITY("VADM",$J,1)
96 S $P(TMP,"^",2)=$P(^UTILITY("VADM",$J,2),"^",1)
97 S Y=+^UTILITY("VADM",$J,3) D DD^%DT S $P(TMP,"^",3)=Y
98 S $P(TMP,"^",4)=VA("PID")
99 K ^UTILITY("VADM",$J)
100 Q TMP
101 ;
102PDXVER() ;RETURN VERSION OF PDX IN USE
103 ;INPUT : None
104 ;OUTPUT : N - Version of PDX in use at facility
105 ; -1^Error_Text - Error
106 ;
107 ;DECLARE VARIABLES
108 N X,Y
109 S X=+$G(^DD(394.61,0,"VR"))
110 S Y=$D(^DD(394))
111 ;NOT INSTALLED
112 Q:(('X)&('Y)) "-1^PDX has not been installed"
113 ;VERSION 1.0
114 Q:(('X)&(Y)) "1.0"
115 ;VERSION 1.5 AND UP
116 Q X
117 ;
118APDX ;CONTINUATION OF APDX X-REF ON *PDX TRANSACTION FILE (# 394)
119 ; THIS IS LEFT OVER FROM VERSION 1.0 - INCLUDED TO PASS %INDEX
120 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)=""
121 K:VAQTMP=1 VAQ15,VAQ16 K VAQTMP
122 Q
Note: See TracBrowser for help on using the repository browser.