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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORPUT02 4535 printed Apr 09, 2024@20:47:33 Page 2
RORPUT02 ;HCIOFO/SG - DATA TRANSPORT FOR KIDS ; 12/9/05 11:26am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** LOADS 'ROR LIST ITEM' FILE (#799.1) INTO TRANSPORT GLOBAL
LD7991() ;
+1 NEW RORBUF,RORMSG,TMP
+2 SET TMP="@;.01;.02;.03;.04;1"
+3 DO LIST^DIC(799.1,,TMP,"KPQ",,,,,,,"RORBUF","RORMSG")
+4 KILL RORBUF("DILIST",0)
+5 MERGE @XPDGREF@("ROR LIST ITEM")=RORBUF("DILIST")
+6 QUIT
+7 ;
+8 ;***** LOADS 'ROR GENERIG DRUG' FILE (#799.51) INTO TRANSPORT GLOBAL
LD79951() ;
+1 NEW IR,RORBUF,RORMSG,TMP
+2 SET TMP="@;.01I;.02E;.03I;.04I;.04E;.09I"
+3 DO LIST^DIC(799.51,,TMP,"KPQ",,,,,,,"RORBUF","RORMSG")
+4 KILL RORBUF("DILIST",0)
+5 SET IR=0
+6 FOR
SET IR=$ORDER(RORBUF("DILIST",IR))
if IR'>0
QUIT
Begin DoDot:1
+7 SET TMP=+$PIECE(RORBUF("DILIST",IR,0),U,4)
+8 if TMP>0
SET $PIECE(RORBUF("DILIST",IR,0),U,4)=$$ITEMCODE^RORUTL09(TMP)
End DoDot:1
+9 MERGE @XPDGREF@("ROR GENERIC DRUG")=RORBUF("DILIST")
+10 QUIT
+11 ;
+12 ;**** LOADS PREDEFINED REPORT TEMPLATES INTO TRANSPORT GLOBAL
LDPRT() ;
+1 NEW IPRT,RORBUF,RORLST,TMP
+2 DO GETPLIST^RORRP038(.RORLST,"ROR REPORT PARAMS TEMPLATE")
+3 SET IPRT=0
+4 FOR
SET IPRT=$ORDER(RORLST(IPRT))
if IPRT'>0
QUIT
Begin DoDot:1
+5 if $PIECE(RORLST(IPRT),U,2)'="CCR Predefined Report Template"
QUIT
+6 SET TMP=$PIECE(RORLST(IPRT),U)_U_"ROR REPORT PARAMS TEMPLATE"
+7 DO GETPARM^RORRP038(.RORBUF,TMP,"PKG")
+8 if $GET(RORBUF(0))<0
QUIT
+9 KILL RORBUF(0)
if $DATA(RORBUF)<10
QUIT
+10 MERGE @XPDGREF@("RORPRTDEF",IPRT)=RORBUF
+11 SET @XPDGREF@("RORPRTDEF",IPRT)=$PIECE(RORLST(IPRT),U)
End DoDot:1
+12 QUIT
+13 ;
+14 ;***** RESTORES 'ROR LIST ITEM' FILE (#799.1) FROM TRANSPORT GLOBAL
+15 ;
+16 ; Return Values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ;
RS7991() ;
+1 NEW IENS,II,RC,RORBUF,RORFDA,RORMSG
+2 SET (II,RC)=0
SET IENS="?+1,"
+3 FOR
SET II=$ORDER(@XPDGREF@("ROR LIST ITEM",II))
if II'>0
QUIT
Begin DoDot:1
+4 SET RORBUF=$GET(@XPDGREF@("ROR LIST ITEM",II,0))
if RORBUF?."^"
QUIT
+5 KILL RORFDA,RORMSG
+6 ; TEXT
SET RORFDA(799.1,IENS,.01)=$PIECE(RORBUF,U,2)
+7 ; TYPE
SET RORFDA(799.1,IENS,.02)=$PIECE(RORBUF,U,3)
+8 ; REGISTRY
SET RORFDA(799.1,IENS,.03)=$PIECE(RORBUF,U,4)
+9 ; CODE
SET RORFDA(799.1,IENS,.04)=$PIECE(RORBUF,U,5)
+10 ; DATE OF INACTIVATION
SET RORFDA(799.1,IENS,1)=$PIECE(RORBUF,U,6)
+11 DO UPDATE^DIE("EK","RORFDA",,"RORMSG")
+12 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
End DoDot:1
if RC<0
QUIT
+13 QUIT $SELECT(RC<0:RC,1:0)
+14 ;
+15 ;***** RESTORES 'ROR GENERIG DRUG' FILE (#799.51) FROM TRANSP. GLOBAL
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; 0 Ok
+20 ;
RS79951() ;
+1 NEW ERRCNT,IENS,II,RC,REGIEN,RORBUF,RORFDA,RORMSG,TMP,VGIEN,VGNAME
+2 DO BMES^RORKIDS("Restoring the ROR GENERIC DRUG data...")
+3 ;---
+4 SET (ERRCNT,II,RC)=0
SET IENS="?+1,"
+5 FOR
SET II=$ORDER(@XPDGREF@("ROR GENERIC DRUG",II))
if II'>0
QUIT
Begin DoDot:1
+6 SET RORBUF=$GET(@XPDGREF@("ROR GENERIC DRUG",II,0))
if RORBUF?."^"
QUIT
+7 KILL RORFDA,RORMSG
+8 ; NAME
SET RORFDA(799.51,IENS,.01)=$PIECE(RORBUF,U,2)
+9 ; NATIONAL
SET RORFDA(799.51,IENS,.09)=$PIECE(RORBUF,U,7)
+10 ;---
+11 SET REGIEN=$$REGIEN^RORUTL02($PIECE(RORBUF,U,3))
+12 IF REGIEN<0
SET RC=REGIEN
QUIT
+13 ; REGISTRY
SET RORFDA(799.51,IENS,.02)=REGIEN
+14 ;---
+15 SET TMP=$$ITEMIEN^RORUTL09(4,REGIEN,$PIECE(RORBUF,U,4))
+16 IF TMP<0
SET RC=TMP
QUIT
+17 ; DRUG GROUP
SET RORFDA(799.51,IENS,.03)=TMP
+18 ;---
+19 SET VGIEN=+$PIECE(RORBUF,U,5)
SET VGNAME=$$VAGN^PSNAPIS(VGIEN)
+20 IF VGNAME'=$PIECE(RORBUF,U,6)
Begin DoDot:2
+21 KILL TMP
SET ERRCNT=ERRCNT+1
+22 SET TMP(1)="A record of the ROR GENERIC DRUG file (#799.51) has"
+23 SET TMP(2)="not been restored due to failed pointer resolution."
+24 SET TMP(3)="The corresponding entry #"_VGIEN_" of the VA GENERIC"
+25 SET TMP(4)="file (#50.6) has a different name or missing."
+26 SET TMP(5)="KIDS: "_$PIECE(RORBUF,U,6)
+27 SET TMP(6)="Site: "_$SELECT(VGNAME'="0":VGNAME,1:"Not Defined")
+28 DO ERROR^RORERR(-110,,.TMP)
End DoDot:2
QUIT
+29 ; VA GENERIC
SET RORFDA(799.51,IENS,.04)=VGIEN
+30 ;---
+31 DO UPDATE^DIE("K","RORFDA",,"RORMSG")
+32 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,799.1,IENS)
End DoDot:1
if RC<0
QUIT
+33 ;---
+34 IF 'ERRCNT
SET TMP="successfully restored."
+35 IF '$TEST
SET TMP="restored with errors. See CCR logs for details."
+36 DO MES^RORKIDS("Data has been "_TMP)
+37 QUIT $SELECT(RC<0:RC,1:0)
+38 ;
+39 ;***** RESTORES PREDEFINED REPORT TEMPLATES
+40 ;
+41 ; Return Values:
+42 ; <0 Error code
+43 ; 0 Ok
+44 ;
RSPRT() ;
+1 NEW IPRT,RC,RESULTS,RORBUF,TMP
+2 DO BMES^RORKIDS("Restoring predefined report templates...")
+3 ;---
+4 SET (IPRT,RC)=0
+5 FOR
SET IPRT=$ORDER(@XPDGREF@("RORPRTDEF",IPRT))
if IPRT'>0
QUIT
Begin DoDot:1
+6 KILL RORBUF
+7 MERGE RORBUF=@XPDGREF@("RORPRTDEF",IPRT)
+8 if $DATA(RORBUF)<10
QUIT
+9 SET TMP=$PIECE(RORBUF,U)_U_"ROR REPORT PARAMS TEMPLATE"
+10 SET RORBUF="CCR Predefined Report Template"
+11 DO SETPARM^RORRP038(.RESULTS,TMP,"PKG",.RORBUF)
+12 SET RC=+$GET(RESULTS(0))
End DoDot:1
if RC<0
QUIT
+13 if RC<0
QUIT RC
+14 ;---
+15 DO MES^RORKIDS("Templates have been restored successfully.")
+16 QUIT 0
