132 lines
4.3 KiB
Mathematica
132 lines
4.3 KiB
Mathematica
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
|