source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/VSITVAR.m@ 975

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1VSITVAR ;ISD/RJP - Define Visit Array Variables ;6/20/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
3 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
4 ; the incorporation of the module into PCE. For historical reference,
5 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
6 ; patches.
7 ;
8 ;;2.0;VISIT TRACKING;;Aug 12, 1996;
9 Q
10 ;
11 ; - IEN = <visit record number>
12 ; FLD = <field mnemonic>
13 ; VAL = <data value>
14 ; VSITDD0 = <indirect reference to dd for field>
15 ; FMT = <output format [I:internal/E:external/B:both]>
16 ; WITHIEN = 1: first subscript of VSIT array is IEN second is field.
17 ; 0,"",not passed: field is only subscript
18 ;
19ALL(IEN,FMT,WITHIEN) ; - define all VSIT("xxx") nodes using record # IEN
20 ;
21 N REC,FLD,FLDINDX,VAL,VSITI
22 S IEN=+$G(IEN),FMT=$G(FMT),WITHIEN=$G(WITHIEN)
23 D:'($D(^TMP("VSITDD",$J))\10) FLD^VSITFLD
24 S VSITI=0
25 S REC(0)=$G(^AUPNVSIT(IEN,0)) F S VSITI=$O(^(VSITI)) Q:VSITI'>0 S REC(VSITI)=^(VSITI)
26 S FLDINDX=""
27 F S FLDINDX=$O(^TMP("VSITDD",$J,FLDINDX)) Q:FLDINDX="" D
28 . S FLD=$G(^TMP("VSITDD",$J,FLDINDX))
29 . S VAL=$P($G(REC($P(FLD,";",3))),"^",$P(FLD,";",4))
30 . I WITHIEN S VSIT(IEN,FLDINDX)=$$GET(FLDINDX,VAL,FMT)
31 . E S VSIT(FLDINDX)=$$GET(FLDINDX,VAL,FMT)
32 Q
33 ;
34SLC(IEN,FLD,FMT) ; - define only VSIT(FLD) node using record # IEN
35 ;
36 N REC,NXT,VAL,VSITI
37 S IEN=$G(IEN),FLD=$G(FLD),FMT=$G(FMT)
38 D:'($D(^TMP("VSITDD",$J))\10) FLD^VSITFLD
39 F VSITI=1:1:$L(FLD,"^") S NXT=$P(FLD,"^",VSITI) D:NXT]""
40 . D:$G(REC($P(^TMP("VSITDD",$J,NXT),";",3)))=""
41 . . S REC($P(^TMP("VSITDD",$J,NXT),";",3))=$G(^AUPNVSIT(IEN,$P(^TMP("VSITDD",$J,NXT),";",3)))
42 . S VAL=$P($G(REC($P(^TMP("VSITDD",$J,NXT),";",3))),"^",$P(^TMP("VSITDD",$J,NXT),";",4))
43 . S VSIT(NXT)=$$GET(NXT,VAL,FMT)
44 K FMT
45 Q
46 ;
47 ; ---------------------------------------------------------------------
48 ;
49GET(FLD,VAL,FMT,DATEFMT) ; - Get/Check value for field
50 ;
51 N X,Y,VSITDD0
52 S FLD=$G(FLD),VAL=$G(VAL),FMT=$G(FMT)
53 D:'($D(^TMP("VSITDD",$J))\10) FLD^VSITFLD
54 S Y=""
55 S FLD=$G(^TMP("VSITDD",$J,FLD))
56 D:FLD]""
57 . S VSITDD0=$P($G(^DD(9000010,$P(FLD,";",2),0)),"^",2)
58 . S Y=$S(VSITDD0["N":"TXT",VSITDD0["F":"TXT",VSITDD0["P":"PTR",VSITDD0["S":"SET",VSITDD0["D":"DAT",1:"")
59 . S VSITDD0="^DD(9000010,"_$P(FLD,";",2)_",0)"
60 Q $S(Y="TXT":$$TXT(VAL,FMT),Y="DAT":$$DAT(VAL,FMT,$G(DATEFMT)),Y="SET":$$SET(VAL,FMT,VSITDD0),Y="PTR":$$PTR(VAL,FMT,VSITDD0),1:"")
61 ;
62TXT(VAL,FMT) ; - number/free text valued data
63 ;
64 S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
65 Q $S("IB"[FMT:VAL,1:"")_$S("EB"[FMT:$S(VAL]"":"^",1:"")_VAL,1:"")
66 ;
67DAT(VAL,FMT,DATEFMT) ; - date valued data
68 ;
69 N X,Y,%DT
70 S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
71 S %DT=$S($G(DATEFMT)]"":DATEFMT,1:"TSX")
72 S X=VAL
73 D ^%DT K %DT S VAL=$S(Y>0:Y,1:"")
74 S:"EB"[FMT&(Y]"") Y=$$FMTE^XLFDT(VAL,"1P")
75 Q $S("IB"[FMT:VAL,1:"")_$S("EB"[FMT:$S(Y]"":"^",1:"")_Y,1:"")
76 ;
77SET(VAL,FMT,VSITDD0) ; - set of codes valued data
78 ;
79 N Y S Y=""
80 S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
81 S VSITDD0=$G(@VSITDD0),VSITDD0=$S($P(VSITDD0,"^",2)'["S":"",1:";"_$P(VSITDD0,"^",3))
82 D:VAL]""
83 . I VSITDD0[(";"_$P(VAL,"^")_":") S Y=$P(VSITDD0,";",$L($E(VSITDD0,1,$F(VSITDD0,";"_$P(VAL,"^")_":")),";")) ; - internal code
84 . E S Y=$P(VSITDD0,";",$L($E(VSITDD0,1,$F(VSITDD0,":"_$TR(VAL,"^"))-1),";")) ; - external code
85 . S Y=$TR(Y,":","^")
86 Q $S("IB"[FMT:$P(Y,"^"),1:"")_$S("EB"[FMT:$S($P(Y,"^",2)]"":"^",1:"")_$P(Y,"^",2),1:"")
87 ;
88PTR(VAL,FMT,VSITDD0) ; - pointer valued data
89 ;
90 N D,Y,DIC S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
91 S VSITDD0=$G(@VSITDD0),Y="" D:$P(VSITDD0,"^",2)["P"
92 . F I $D(@("^"_$P(^(0),"^",3)_"0)")) S VSITDD0=$P(^(0),"^",2) Q:'$D(^(+VAL,0)) S Y=$P(^(0),"^") I $D(^DD(+VSITDD0,.01,0)) S VSITDD0=$P(^(0),"^",2) Q:VSITDD0'["P"
93 S:Y]"" Y=VAL_"^"_Y
94 I +VSITDD0,'+$P(Y,"^") S X=VAL,DIC=+VSITDD0,DIC(0)="N",D="B" D IX^DIC S Y=$S(Y>0:Y,1:"")
95 Q $S("IB"[FMT:$P(Y,"^"),1:"")_$S("EB"[FMT:$S($P(Y,"^",2)]"":"^",1:"")_$P(Y,"^",2),1:"")
Note: See TracBrowser for help on using the repository browser.