source: ccr/trunk/p/C0CSUB1.m@ 1806

Last change on this file since 1806 was 1586, checked in by Sam Habiel, 12 years ago

Changed license to AGPL. Some clean-up for XINDEX

  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CSUB1.m1290
    /ccr/branches/ohum/p/C0CSUB1.m1291-1543
    /ccr/branches/ohum/p/p/C0CSUB1.m1287-1289
File size: 4.6 KB
Line 
1C0CSUB1 ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
3 ;Copyright 2009 George Lilly.
4 ;
5 ; This program is free software: you can redistribute it and/or modify
6 ; it under the terms of the GNU Affero General Public License as
7 ; published by the Free Software Foundation, either version 3 of the
8 ; License, or (at your option) any later version.
9 ;
10 ; This program is distributed in the hope that it will be useful,
11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ; GNU Affero General Public License for more details.
14 ;
15 ; You should have received a copy of the GNU Affero General Public License
16 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
17 ;
18 W "This is the CCR SUBSCRIPTIONN Utility Library ",!
19 Q
20 ;
21CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
22 ;
23 S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM"))
24 S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
25 S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
26 S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
27 S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
28 S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
29 K C0CFDA
30 S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
31 I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
32 E Q ; NO CHECKSUMS FOR THISPATIENT
33 D UPDIE
34 N C0CJ S C0CJ=""
35 F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN
36 . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
37 . W C0CJ," ",C0CD,!
38 . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
39 . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
40 . D UPDIE
41 Q
42 ;
43SUBALL ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1
44 ;
45 S C0CGLB=$NA(^TMP("C0CRIM","VARS"))
46 S C0CI=""
47 F S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI="" D ; FOR EACH PATIENT
48 . D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN
49 Q
50 ;
51SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS
52 ;
53 S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
54 S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
55 S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS
56 S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE
57 K C0CFDA
58 S C0CFDA(C0CSF,"+1,",.01)=DFN
59 D UPDIE ; ADD THE PATIENT
60 S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
61 S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER
62 D UPDIE ; ADD THE SUBSCRIPTION
63 D CHK1(DFN) ; ADD THE CHECKSUMS
64 Q
65 ;
66UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
67 K ZERR
68 D CLEAN^DILF
69 D UPDATE^DIE("","C0CFDA","","ZERR")
70 I $D(ZERR) S $EC=",U1,"
71 K C0CFDA
72 Q
73 ;
74VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
75 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
76 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
77 ;
78 N ZCCRD,ZVARN,C0CFDA2
79 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
80 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
81 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
82 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
83 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
84 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
85 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
86 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
87 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
88 . I $D(ZERR) D ; LAYGO ERROR
89 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
90 . E D ;
91 . . D CLEAN^DILF ; CLEAN UP
92 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
93 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
94 Q ZVARN
95 ;
96SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
97 ; TO SET TO VALUE C0CSV.
98 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
99 ; C0CSN,C0CSV ARE PASSED BY VALUE
100 ;
101 N C0CSI,C0CSJ
102 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
103 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
104 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
105 Q
106ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
107 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
108 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
109 I '$D(ZTAB) S ZTAB="C0CA"
110 N ZR
111 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
112 E S ZR=""
113 Q ZR
114ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
115 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
116 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
117 I '$D(ZTAB) S ZTAB="C0CA"
118 N ZR
119 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
120 E S ZR=""
121 Q ZR
122 ;
123ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
124 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
125 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
126 I '$D(ZTAB) S ZTAB="C0CA"
127 N ZR
128 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
129 E S ZR=""
130 Q ZR
131 ;
Note: See TracBrowser for help on using the repository browser.