RORPUT02 ;HCIOFO/SG - DATA TRANSPORT FOR KIDS ; 12/9/05 11:26am ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006 ; Q ; ;***** LOADS 'ROR LIST ITEM' FILE (#799.1) INTO TRANSPORT GLOBAL LD7991() ; N RORBUF,RORMSG,TMP S TMP="@;.01;.02;.03;.04;1" D LIST^DIC(799.1,,TMP,"KPQ",,,,,,,"RORBUF","RORMSG") K RORBUF("DILIST",0) M @XPDGREF@("ROR LIST ITEM")=RORBUF("DILIST") Q ; ;***** LOADS 'ROR GENERIG DRUG' FILE (#799.51) INTO TRANSPORT GLOBAL LD79951() ; N IR,RORBUF,RORMSG,TMP S TMP="@;.01I;.02E;.03I;.04I;.04E;.09I" D LIST^DIC(799.51,,TMP,"KPQ",,,,,,,"RORBUF","RORMSG") K RORBUF("DILIST",0) S IR=0 F S IR=$O(RORBUF("DILIST",IR)) Q:IR'>0 D . S TMP=+$P(RORBUF("DILIST",IR,0),U,4) . S:TMP>0 $P(RORBUF("DILIST",IR,0),U,4)=$$ITEMCODE^RORUTL09(TMP) M @XPDGREF@("ROR GENERIC DRUG")=RORBUF("DILIST") Q ; ;**** LOADS PREDEFINED REPORT TEMPLATES INTO TRANSPORT GLOBAL LDPRT() ; N IPRT,RORBUF,RORLST,TMP D GETPLIST^RORRP038(.RORLST,"ROR REPORT PARAMS TEMPLATE") S IPRT=0 F S IPRT=$O(RORLST(IPRT)) Q:IPRT'>0 D . Q:$P(RORLST(IPRT),U,2)'="CCR Predefined Report Template" . S TMP=$P(RORLST(IPRT),U)_U_"ROR REPORT PARAMS TEMPLATE" . D GETPARM^RORRP038(.RORBUF,TMP,"PKG") . Q:$G(RORBUF(0))<0 . K RORBUF(0) Q:$D(RORBUF)<10 . M @XPDGREF@("RORPRTDEF",IPRT)=RORBUF . S @XPDGREF@("RORPRTDEF",IPRT)=$P(RORLST(IPRT),U) Q ; ;***** RESTORES 'ROR LIST ITEM' FILE (#799.1) FROM TRANSPORT GLOBAL ; ; Return Values: ; <0 Error code ; 0 Ok ; RS7991() ; N IENS,II,RC,RORBUF,RORFDA,RORMSG S (II,RC)=0,IENS="?+1," F S II=$O(@XPDGREF@("ROR LIST ITEM",II)) Q:II'>0 D Q:RC<0 . S RORBUF=$G(@XPDGREF@("ROR LIST ITEM",II,0)) Q:RORBUF?."^" . K RORFDA,RORMSG . S RORFDA(799.1,IENS,.01)=$P(RORBUF,U,2) ; TEXT . S RORFDA(799.1,IENS,.02)=$P(RORBUF,U,3) ; TYPE . S RORFDA(799.1,IENS,.03)=$P(RORBUF,U,4) ; REGISTRY . S RORFDA(799.1,IENS,.04)=$P(RORBUF,U,5) ; CODE . S RORFDA(799.1,IENS,1)=$P(RORBUF,U,6) ; DATE OF INACTIVATION . D UPDATE^DIE("EK","RORFDA",,"RORMSG") . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS) Q $S(RC<0:RC,1:0) ; ;***** RESTORES 'ROR GENERIG DRUG' FILE (#799.51) FROM TRANSP. GLOBAL ; ; Return Values: ; <0 Error code ; 0 Ok ; RS79951() ; N ERRCNT,IENS,II,RC,REGIEN,RORBUF,RORFDA,RORMSG,TMP,VGIEN,VGNAME D BMES^RORKIDS("Restoring the ROR GENERIC DRUG data...") ;--- S (ERRCNT,II,RC)=0,IENS="?+1," F S II=$O(@XPDGREF@("ROR GENERIC DRUG",II)) Q:II'>0 D Q:RC<0 . S RORBUF=$G(@XPDGREF@("ROR GENERIC DRUG",II,0)) Q:RORBUF?."^" . K RORFDA,RORMSG . S RORFDA(799.51,IENS,.01)=$P(RORBUF,U,2) ; NAME . S RORFDA(799.51,IENS,.09)=$P(RORBUF,U,7) ; NATIONAL . ;--- . S REGIEN=$$REGIEN^RORUTL02($P(RORBUF,U,3)) . I REGIEN<0 S RC=REGIEN Q . S RORFDA(799.51,IENS,.02)=REGIEN ; REGISTRY . ;--- . S TMP=$$ITEMIEN^RORUTL09(4,REGIEN,$P(RORBUF,U,4)) . I TMP<0 S RC=TMP Q . S RORFDA(799.51,IENS,.03)=TMP ; DRUG GROUP . ;--- . S VGIEN=+$P(RORBUF,U,5),VGNAME=$$VAGN^PSNAPIS(VGIEN) . I VGNAME'=$P(RORBUF,U,6) D Q . . K TMP S ERRCNT=ERRCNT+1 . . S TMP(1)="A record of the ROR GENERIC DRUG file (#799.51) has" . . S TMP(2)="not been restored due to failed pointer resolution." . . S TMP(3)="The corresponding entry #"_VGIEN_" of the VA GENERIC" . . S TMP(4)="file (#50.6) has a different name or missing." . . S TMP(5)="KIDS: "_$P(RORBUF,U,6) . . S TMP(6)="Site: "_$S(VGNAME'="0":VGNAME,1:"Not Defined") . . D ERROR^RORERR(-110,,.TMP) . S RORFDA(799.51,IENS,.04)=VGIEN ; VA GENERIC . ;--- . D UPDATE^DIE("K","RORFDA",,"RORMSG") . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS) ;--- I 'ERRCNT S TMP="successfully restored." E S TMP="restored with errors. See CCR logs for details." D MES^RORKIDS("Data has been "_TMP) Q $S(RC<0:RC,1:0) ; ;***** RESTORES PREDEFINED REPORT TEMPLATES ; ; Return Values: ; <0 Error code ; 0 Ok ; RSPRT() ; N IPRT,RC,RESULTS,RORBUF,TMP D BMES^RORKIDS("Restoring predefined report templates...") ;--- S (IPRT,RC)=0 F S IPRT=$O(@XPDGREF@("RORPRTDEF",IPRT)) Q:IPRT'>0 D Q:RC<0 . K RORBUF . M RORBUF=@XPDGREF@("RORPRTDEF",IPRT) . Q:$D(RORBUF)<10 . S TMP=$P(RORBUF,U)_U_"ROR REPORT PARAMS TEMPLATE" . S RORBUF="CCR Predefined Report Template" . D SETPARM^RORRP038(.RESULTS,TMP,"PKG",.RORBUF) . S RC=+$G(RESULTS(0)) Q:RC<0 RC ;--- D MES^RORKIDS("Templates have been restored successfully.") Q 0