source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORPUT02.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1RORPUT02 ;HCIOFO/SG - DATA TRANSPORT FOR KIDS ; 12/9/05 11:26am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** LOADS 'ROR LIST ITEM' FILE (#799.1) INTO TRANSPORT GLOBAL
7LD7991() ;
8 N RORBUF,RORMSG,TMP
9 S TMP="@;.01;.02;.03;.04;1"
10 D LIST^DIC(799.1,,TMP,"KPQ",,,,,,,"RORBUF","RORMSG")
11 K RORBUF("DILIST",0)
12 M @XPDGREF@("ROR LIST ITEM")=RORBUF("DILIST")
13 Q
14 ;
15 ;***** LOADS 'ROR GENERIG DRUG' FILE (#799.51) INTO TRANSPORT GLOBAL
16LD79951() ;
17 N IR,RORBUF,RORMSG,TMP
18 S TMP="@;.01I;.02E;.03I;.04I;.04E;.09I"
19 D LIST^DIC(799.51,,TMP,"KPQ",,,,,,,"RORBUF","RORMSG")
20 K RORBUF("DILIST",0)
21 S IR=0
22 F S IR=$O(RORBUF("DILIST",IR)) Q:IR'>0 D
23 . S TMP=+$P(RORBUF("DILIST",IR,0),U,4)
24 . S:TMP>0 $P(RORBUF("DILIST",IR,0),U,4)=$$ITEMCODE^RORUTL09(TMP)
25 M @XPDGREF@("ROR GENERIC DRUG")=RORBUF("DILIST")
26 Q
27 ;
28 ;**** LOADS PREDEFINED REPORT TEMPLATES INTO TRANSPORT GLOBAL
29LDPRT() ;
30 N IPRT,RORBUF,RORLST,TMP
31 D GETPLIST^RORRP038(.RORLST,"ROR REPORT PARAMS TEMPLATE")
32 S IPRT=0
33 F S IPRT=$O(RORLST(IPRT)) Q:IPRT'>0 D
34 . Q:$P(RORLST(IPRT),U,2)'="CCR Predefined Report Template"
35 . S TMP=$P(RORLST(IPRT),U)_U_"ROR REPORT PARAMS TEMPLATE"
36 . D GETPARM^RORRP038(.RORBUF,TMP,"PKG")
37 . Q:$G(RORBUF(0))<0
38 . K RORBUF(0) Q:$D(RORBUF)<10
39 . M @XPDGREF@("RORPRTDEF",IPRT)=RORBUF
40 . S @XPDGREF@("RORPRTDEF",IPRT)=$P(RORLST(IPRT),U)
41 Q
42 ;
43 ;***** RESTORES 'ROR LIST ITEM' FILE (#799.1) FROM TRANSPORT GLOBAL
44 ;
45 ; Return Values:
46 ; <0 Error code
47 ; 0 Ok
48 ;
49RS7991() ;
50 N IENS,II,RC,RORBUF,RORFDA,RORMSG
51 S (II,RC)=0,IENS="?+1,"
52 F S II=$O(@XPDGREF@("ROR LIST ITEM",II)) Q:II'>0 D Q:RC<0
53 . S RORBUF=$G(@XPDGREF@("ROR LIST ITEM",II,0)) Q:RORBUF?."^"
54 . K RORFDA,RORMSG
55 . S RORFDA(799.1,IENS,.01)=$P(RORBUF,U,2) ; TEXT
56 . S RORFDA(799.1,IENS,.02)=$P(RORBUF,U,3) ; TYPE
57 . S RORFDA(799.1,IENS,.03)=$P(RORBUF,U,4) ; REGISTRY
58 . S RORFDA(799.1,IENS,.04)=$P(RORBUF,U,5) ; CODE
59 . S RORFDA(799.1,IENS,1)=$P(RORBUF,U,6) ; DATE OF INACTIVATION
60 . D UPDATE^DIE("EK","RORFDA",,"RORMSG")
61 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
62 Q $S(RC<0:RC,1:0)
63 ;
64 ;***** RESTORES 'ROR GENERIG DRUG' FILE (#799.51) FROM TRANSP. GLOBAL
65 ;
66 ; Return Values:
67 ; <0 Error code
68 ; 0 Ok
69 ;
70RS79951() ;
71 N ERRCNT,IENS,II,RC,REGIEN,RORBUF,RORFDA,RORMSG,TMP,VGIEN,VGNAME
72 D BMES^RORKIDS("Restoring the ROR GENERIC DRUG data...")
73 ;---
74 S (ERRCNT,II,RC)=0,IENS="?+1,"
75 F S II=$O(@XPDGREF@("ROR GENERIC DRUG",II)) Q:II'>0 D Q:RC<0
76 . S RORBUF=$G(@XPDGREF@("ROR GENERIC DRUG",II,0)) Q:RORBUF?."^"
77 . K RORFDA,RORMSG
78 . S RORFDA(799.51,IENS,.01)=$P(RORBUF,U,2) ; NAME
79 . S RORFDA(799.51,IENS,.09)=$P(RORBUF,U,7) ; NATIONAL
80 . ;---
81 . S REGIEN=$$REGIEN^RORUTL02($P(RORBUF,U,3))
82 . I REGIEN<0 S RC=REGIEN Q
83 . S RORFDA(799.51,IENS,.02)=REGIEN ; REGISTRY
84 . ;---
85 . S TMP=$$ITEMIEN^RORUTL09(4,REGIEN,$P(RORBUF,U,4))
86 . I TMP<0 S RC=TMP Q
87 . S RORFDA(799.51,IENS,.03)=TMP ; DRUG GROUP
88 . ;---
89 . S VGIEN=+$P(RORBUF,U,5),VGNAME=$$VAGN^PSNAPIS(VGIEN)
90 . I VGNAME'=$P(RORBUF,U,6) D Q
91 . . K TMP S ERRCNT=ERRCNT+1
92 . . S TMP(1)="A record of the ROR GENERIC DRUG file (#799.51) has"
93 . . S TMP(2)="not been restored due to failed pointer resolution."
94 . . S TMP(3)="The corresponding entry #"_VGIEN_" of the VA GENERIC"
95 . . S TMP(4)="file (#50.6) has a different name or missing."
96 . . S TMP(5)="KIDS: "_$P(RORBUF,U,6)
97 . . S TMP(6)="Site: "_$S(VGNAME'="0":VGNAME,1:"Not Defined")
98 . . D ERROR^RORERR(-110,,.TMP)
99 . S RORFDA(799.51,IENS,.04)=VGIEN ; VA GENERIC
100 . ;---
101 . D UPDATE^DIE("K","RORFDA",,"RORMSG")
102 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
103 ;---
104 I 'ERRCNT S TMP="successfully restored."
105 E S TMP="restored with errors. See CCR logs for details."
106 D MES^RORKIDS("Data has been "_TMP)
107 Q $S(RC<0:RC,1:0)
108 ;
109 ;***** RESTORES PREDEFINED REPORT TEMPLATES
110 ;
111 ; Return Values:
112 ; <0 Error code
113 ; 0 Ok
114 ;
115RSPRT() ;
116 N IPRT,RC,RESULTS,RORBUF,TMP
117 D BMES^RORKIDS("Restoring predefined report templates...")
118 ;---
119 S (IPRT,RC)=0
120 F S IPRT=$O(@XPDGREF@("RORPRTDEF",IPRT)) Q:IPRT'>0 D Q:RC<0
121 . K RORBUF
122 . M RORBUF=@XPDGREF@("RORPRTDEF",IPRT)
123 . Q:$D(RORBUF)<10
124 . S TMP=$P(RORBUF,U)_U_"ROR REPORT PARAMS TEMPLATE"
125 . S RORBUF="CCR Predefined Report Template"
126 . D SETPARM^RORRP038(.RESULTS,TMP,"PKG",.RORBUF)
127 . S RC=+$G(RESULTS(0))
128 Q:RC<0 RC
129 ;---
130 D MES^RORKIDS("Templates have been restored successfully.")
131 Q 0
Note: See TracBrowser for help on using the repository browser.