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

RORHIV03.m

Go to the documentation of this file. 
  1. RORHIV03 ;HCIOFO/SG - CONVERSION OF THE FILE #158 ; 5/12/05 2:53pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** TRANSFERS THE CDC COMMENTS TO THE MULTIPLE #25
  1. CDCOMM() ;
  1.  N CNT,I,IENS,RC,RORBUF,RORFDA,RORMSG,TMP
  1.  S (CNT,RC)=0
  1.  ;--- Load the old comments (non-empty ones)
  1.  F I=3,2,1  D
  1.  . S TMP=$G(^IMR(158,IMRIEN,I+9))
  1.  . S:(TMP'="")!CNT RORBUF(I,0)=TMP,CNT=CNT+1
  1.  ;--- Store the comments in the new word processing field
  1.  D:$D(RORBUF)>1
  1.  . S IENS=RORIEN_","
  1.  . S RORFDA(799.4,IENS,25)="RORBUF"
  1.  . D UPDATE^DIE(,"RORFDA",,"RORMSG")
  1.  . I $G(DIERR)  D
  1.  . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
  1.  Q $S(RC<0:RC,1:0)
  1.  ;
  1.  ;***** TRANSFERS THE PATIENT'S DATA FROM FILE #158 TO FILE #799.4
  1.  ;
  1.  ; IMRIEN        IEN of the IMMUNOLOGY CASE STUDY file record
  1.  ; RORIEN        IEN of the record of the ROR HIV RECORD file
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. CNVPTDAT(IMRIEN,RORIEN) ;
  1.  N DA,DIK,RC,RORNODE,TMP
  1.  S RORNODE=""
  1.  ;--- Check the parameters
  1.  I '$D(^IMR(158,IMRIEN,0))  D  Q RC
  1.  . S RC=$$ERROR^RORERR(-88,,,,"IMRIEN",IMRIEN)
  1.  I '$D(^RORDATA(799.4,RORIEN,0))  D  Q RC
  1.  . S RC=$$ERROR^RORERR(-88,,,,"RORIEN",RORIEN)
  1.  ;---
  1.  S RORNODE=^RORDATA(799.4,RORIEN,0)
  1.  D COPY(0,"42>2,23>3")
  1.  D COPY(1,"7>4")
  1.  I $P(RORNODE,U,2)=4  D  ; CLINICAL AIDS
  1.  . S $P(RORNODE,U,2)=1,TMP=$P(RORNODE,U,3)\1
  1.  . I TMP<1000000  S $P(RORNODE,U,3)=""  Q
  1.  . S:'$E(TMP,4,5) $E(TMP,4,5)="01"
  1.  . S:'$E(TMP,6,7) $E(TMP,6,7)="01"
  1.  . S $P(RORNODE,U,3)=TMP
  1.  E  S $P(RORNODE,U,2,3)=U
  1.  D STORE(0)
  1.  ;---
  1.  D COPY(1,"6>1,34>5,9>9,10>10,11>11,12>12,13>13,14>14")
  1.  D COPY(2,"16>4")
  1.  D COPY(102,"8>7,23>8")
  1.  D COPY(110,"1>2,2>3")
  1.  D COPY(112,"5>6")
  1.  D STORE(9)
  1.  ;---
  1.  D COPY(102,"19>5")
  1.  D COPY(110,"4>1,5>4")
  1.  D COPY(112,"7>2,8>3")
  1.  D STORE(11)
  1.  ;---
  1.  D COPY(1,"16>2,17>3,18>4")
  1.  D COPY(2,"54>1")
  1.  D COPY(102,"10>7")
  1.  D COPY(110,"16>5")
  1.  D COPY(112,"6>6")
  1.  D STORE(12)
  1.  ;---
  1.  D COPY(1,"26>3,20>6,28>7,29>8,30>9,31>10,32>12,21>13,22>14,23>15,24>17")
  1.  D TRANSL(1,19,5,"1,2,3","1,2,8")
  1.  D COPY(2,"21>1,23>2,53>4,55>18")
  1.  D COPY(102,"14>16")
  1.  D COPY(110,"3>11")
  1.  D STORE(14)
  1.  ;---
  1.  D COPY(1,"35>1,36>9")
  1.  D COPY(2,"49>5"),TRANSL(2,50,7,"P,N,I,U","1,0,8,9")
  1.  D COPY(102,"20>11")
  1.  D COPY(108,"27>2,28>6,29>8,30>12")
  1.  D COPY(110,"17>3,18>4,19>13,20>14")
  1.  D STORE(16)
  1.  ;---
  1.  D COPY(111,"10>1,11>2,12>3,13>4,14>5,1>6,2>7,3>8,4>9")
  1.  D STORE(18)
  1.  ;---
  1.  D COPY(102,"21>1,22>3")
  1.  D COPY(108,"31>2")
  1.  D COPY(111,"5>4,6>5,7>6,8>7,9>8")
  1.  D STORE(20)
  1.  ;---
  1.  D COPY(110,"6>1,7>2,8>4,9>5,10>6,11>7,12>8")
  1.  D COPY(112,"11>3")
  1.  D STORE(22)
  1.  ;---
  1.  D TRANSL(110,13,1,"1,2,9","1,0,9")
  1.  D TRANSL(110,14,2,"1,2,9","1,0,9")
  1.  D TRANSL(110,15,3,"1,2,9","1,0,9")
  1.  D COPY(112,"1>4,2>5,3>6,4>7")
  1.  D STORE(23)
  1.  ;---
  1.  S RC=$$INIDIAGS()  Q:RC<0 RC
  1.  S RC=$$CDCOMM()  Q:RC<0 RC
  1.  ;--- Reindex the entry
  1.  S DIK="^RORDATA(799.4,",DA=RORIEN  D IX1^DIK
  1.  Q 0
  1.  ;
  1.  ;***** COPY THE FIELD DATA
  1. COPY(SRCN,PTLIST) ;
  1.  N DSTP,I,SRCP,TMP
  1.  S:'$D(RORNODE(SRCN)) RORNODE(SRCN)=$G(^IMR(158,IMRIEN,SRCN))
  1.  F I=1:1  S TMP=$P(PTLIST,",",I)  Q:TMP=""  D
  1.  . S SRCP=+$P(TMP,">"),DSTP=+$P(TMP,">",2)
  1.  . S TMP=$P(RORNODE(SRCN),U,SRCP)
  1.  . S:TMP'="" $P(RORNODE,U,DSTP)=TMP
  1.  Q
  1.  ;
  1.  ;***** TRANSFER INITIAL DIAGNOSES
  1. INIDIAGS() ;
  1.  ;;01^2;24^108;1
  1.  ;;02^2;25^108;2
  1.  ;;03^102;15^108;3
  1.  ;;04^2;26^108;4
  1.  ;;05^2;27^108;5
  1.  ;;06^2;28^108;6
  1.  ;;07^2;29^108;7
  1.  ;;08^2;30^108;8
  1.  ;;09^2;31^108;9
  1.  ;;10^2;32^108;10
  1.  ;;11^2;33^108;11
  1.  ;;12^2;34^108;12
  1.  ;;13^2;35^108;13
  1.  ;;14^1;36^108;14
  1.  ;;15^2;37^108;15
  1.  ;;16^2;38^108;16
  1.  ;;17^2;39^108;17
  1.  ;;18^102;16^108;18
  1.  ;;19^2;40^108;19
  1.  ;;20^2;41^108;20
  1.  ;;21^2;42^108;21
  1.  ;;22^102;17^108;22
  1.  ;;23^2;43^108;23
  1.  ;;24^2;44^108;24
  1.  ;;25^2;45^108;25
  1.  ;;26^2;46^108;26
  1.  ;
  1.  N BUF,DATE,DIAG,DIEN,I,IENS,RC,RORFDA,RORILST,RORMSG,TMP
  1.  K ^RORDATA(799.4,RORIEN,10)  S RC=0
  1.  ;--- Load the old data nodes (if they have not been loaded yet)
  1.  F I=2,102,108  D:'$D(RORNODE(I))
  1.  . S RORNODE(I)=$G(^IMR(158,IMRIEN,I))
  1.  ;--- Prepare the data
  1.  F I=1:1  S BUF=$P($T(INIDIAGS+I),";;",2,99)  Q:BUF=""  D
  1.  . S DIEN=+BUF
  1.  . S TMP=$P(BUF,U,2),DX=$P(RORNODE(+TMP),U,$P(TMP,";",2))
  1.  . S DX=$TR(DX,"DPN0","12")  Q:DX=""
  1.  . S TMP=$P(BUF,U,3),DATE=$P(RORNODE(+TMP),U,$P(TMP,";",2))
  1.  . ;---
  1.  . S IENS="+"_I_","_RORIEN_","
  1.  . S RORFDA(799.41,IENS,.01)=DIEN
  1.  . S RORFDA(799.41,IENS,.02)=DX
  1.  . S RORFDA(799.41,IENS,.03)=DATE
  1.  . S RORILST(I)=DIEN
  1.  ;--- Store the data
  1.  D:$D(RORFDA)>1
  1.  . D UPDATE^DIE(,"RORFDA","RORILST","RORMSG")
  1.  . I $G(DIERR)  D  Q
  1.  . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.41)
  1.  ;---
  1.  Q $S(RC<0:RC,1:0)
  1.  ;
  1.  ;***** TEMPORARY 'AFTER UPDATE' CALL-BACK ENTRY POINT
  1.  ;
  1.  ; RORIEN        An IEN of the newly added registry record
  1.  ; PATIEN        Patient IEN
  1.  ; REGIEN        Registry IEN
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;
  1. POSTUPD(RORIEN,PATIEN,REGIEN) ;
  1.  N CODE,IEN158,IENS,RC,RORFDA,RORMSG,TMP
  1.  ;--- Perform the standard HIV post-update actions
  1.  S RC=$$POSTUPD^RORUPD62(RORIEN,PATIEN,REGIEN)  Q:RC<0 RC
  1.  ;--- Check if the patient is in the ICR v2.1
  1.  S CODE=$$XOR^RORUTL03(PATIEN)
  1.  S IEN158=$O(^IMR(158,"B",CODE,""))  Q:IEN158'>0 0
  1.  S IENS=RORIEN_","
  1.  ;--- Populate the DATE ENTERED with the date of first selection rule
  1.  S TMP=$$GET1^DIQ(798,IENS,3.2,"I",,"RORMSG")
  1.  D:$G(DIERR) DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
  1.  S:TMP>0 RORFDA(798,IENS,1)=TMP
  1.  ;--- Convert the patient's data
  1.  D:$$CNVPTDAT(IEN158,RORIEN)'<0
  1.  . ;--- Replace the 'Pending' flag with 'Active'
  1.  . S RORFDA(798,IENS,3)=0    ; STATUS (Pending -> Active)
  1.  . S RORFDA(798,IENS,11)="@" ; DON'T SEND
  1.  ;--- Update the registry record if necessary
  1.  I $D(RORFDA)>1  D  Q:RC<0 RC
  1.  . D FILE^DIE(,"RORFDA","RORMSG")
  1.  . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
  1.  ;---
  1.  Q 0
  1.  ;
  1.  ;***** CREATES THE NEW DATA NODE IN THE RECORD OF THE FILE #799.4
  1. STORE(DSTN) ;
  1.  K ^RORDATA(799.4,RORIEN,DSTN)
  1.  S:RORNODE'="" ^RORDATA(799.4,RORIEN,DSTN)=RORNODE
  1.  S RORNODE=""
  1.  Q
  1.  ;
  1.  ;***** TRANSLATE THE SET OF CODES
  1. TRANSL(SRCN,SRCP,DSTP,FROM,TO) ;
  1.  N TMP
  1.  S:'$D(RORNODE(SRCN)) RORNODE(SRCN)=$G(^IMR(158,IMRIEN,SRCN))
  1.  S TMP=$P(RORNODE(SRCN),U,SRCP)
  1.  S:TMP'="" $P(RORNODE,U,DSTP)=$TR(TMP,FROM,TO)
  1.  Q