source: VWGUIRegistration/trunk/VWREGITP.m

Last change on this file was 1806, checked in by Jim B., 5 years ago
File size: 2.6 KB
Line 
1VWREGITP ;Portland,OR/Jim Bell,et al - Client Registration Utility
2 ;2.0;For WorldVistA;**LOCAL**;;;Build 4; Copyright 2015 ad infinitum et ultra *
3 ;Gets data for existing clients/patients
4 ;*****************************************************************
5 ;* Licensed under GNU 2.0 or greater - see license.txt file *
6 ;* Program/application is for the management of input templates *
7 ;* owned by the user (DUZ). *
8 ;* REMINDER: All template fields pertain only to the Patient File*
9 ;* (#2)! *
10 ;*****************************************************************
11 Q ;No fall through - jeb
12 ;
13GPD(RESULT,DATA) ;Get patient data
14 ; ********************************* 8888***
15 ; * DATA_____TEMPLATE(IEN)^FIELDSET^DFN *
16 ; * TEMPLATE__The name(IEN) of a *
17 ; * stored template *
18 ; * FIELDSET_Adhoc fields in a string *
19 ; * as ".01;3;5;.131", etc *
20 ; * DFN______IEN of patient file(#2) *
21 ; * NOTE: TEMPLATE takes precedence *
22 ; * over FIELDSET *
23 ; *****************************************
24 ;
25 K RESULT,AR
26 N VAR,TNUM,FSET,F,DFN
27 I '$L(DATA) S RESULT(0)="No information relayed. Please try again" Q
28 I $P(DATA,"^",3)="" S RESULT(0)="Patient info not relayed. Please try again" Q
29 S VAR="TNUM^ADHOC^DFN" F I=1:1:3 S @$P(VAR,"^",I)=$P(DATA,"^",I)
30 S TNUM=$S(TNUM["(":+$P(TNUM,"(",2),1:TNUM)
31 S DFN=+$P($P(DATA,"^",3),"(",2)
32 S FSET=$S(TNUM:^DIE(TNUM,"DR",1,2),'TNUM&($L(ADHOC)):ADHOC,1:"")
33 D GETS^DIQ(2,DFN_",","**","N","AR")
34 F I=1:1:$L(FSET,";") D
35 . Q:'$L($P(FSET,";",I))
36 . S F=+$P(FSET,";",I)
37 . S RESULT($$INR^VWREGIT)=F_"^"_$G(AR(2,DFN_",",F))
38 Q
39GPDM(RESULT,DATA) ;
40 ; ****************************************************************
41 ; * DATA____Parent Text^Parent field #^PATIENT IEN^TEMPLATE(IEN) *
42 ; ****************************************************************
43 N F,SUBD,DFN,PIEN,X,RIND,FILE,X,Y,TNUM
44 K MX,MAR,RESULT,AR
45 S DFN=+$P(DATA,"^",3)
46 S F=+$P(DATA,"^",2)
47 S TNUM=+$P($P(DATA,"^",4),"(",2)
48 D GETS^DIQ(2,DFN_",",F_"*;","E","AR")
49 S SUBD=+$P(^DD(2,F,0),"^",2) D:+SUBD ;Multiple field values
50 . S MX="AR("_SUBD_")" F S MX=$Q(@MX) Q:MX=""!(+$P(MX,"(",2)'=SUBD) D:$P(MX,",",$L(MX,",")-1)'=.01
51 .. S FILE=SUBD,PIEN=$P(MX,",",2,$L(MX,",")-1),PIEN=$TR(PIEN,"""","")
52 .. K MAR,IMAR
53 .. D GETS^DIQ(FILE,PIEN,"**","E","MAR")
54 .. D GETS^DIQ(FILE,PIEN,"**","I","IMAR")
55 .. S X=$Q(@"MAR"),Y=$Q(@"IMAR")
56 .. I @X'=@Y S @X=@X_"("_@Y_")"
57 .. S X="MAR" ;,RIND=$$INR^VWREGIT
58 .. S RIND=$$INR^VWREGIT,RESULT(RIND)="" F S X=$Q(@X) Q:X="" S RESULT(RIND)=RESULT(RIND)_@X_"^"
59 K AR,MAR,IMAR,MX
60 Q
Note: See TracBrowser for help on using the repository browser.