Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORPUT02

RORPUT02.m

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