| 1 | RORPUT02 ;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 | 
|---|
| 7 | LD7991() ; | 
|---|
| 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 | 
|---|
| 16 | LD79951() ; | 
|---|
| 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 | 
|---|
| 29 | LDPRT() ; | 
|---|
| 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 | ; | 
|---|
| 49 | RS7991() ; | 
|---|
| 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 | ; | 
|---|
| 70 | RS79951() ; | 
|---|
| 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 | ; | 
|---|
| 115 | RSPRT() ; | 
|---|
| 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 | 
|---|