RANMPT1 ;HISC/GJC-Radiopharm interface; ;8/6/97  12:35
 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
 ; 'RAX': Patient IEN, 'RAY': Exam Date (external) ,'RAZ' : Case #  
 ; 'RAIEN702': new IEN in file 70.2
EN1(RAX,RAY,RAZ) ; add minimum entry info into file 70.2
 S RAIEN702=$O(^RADPTN("AA",RAX,RAY,RAZ,0)) Q:RAIEN702 RAIEN702
 N DIERR,RATMP
 S RATMP(70.2,"+1,",.01)=RAX
 S RATMP(70.2,"+1,",2)=RAY,RATMP(70.2,"+1,",3)=RAZ
 D UPDATE^DIE("","RATMP","RAIEN702")
 S RAIEN702=$S(+$G(RAIEN702(1))>0:RAIEN702(1),1:-1)
 I RAIEN702=-1 W !,*7,"  ??",!!,"** Error -- Unable to file drug info **",! G EN1Q
 N RA1,RA2,RAFDA,RAIEN,RAMSG
 Q:'$D(RAOPT("REG")) RAIEN702  ;stuff only during registration
 Q:'$G(RAPRI) RAIEN702
 ; enter default radiopharmaceutical(s) into subflds of file 70.2
 S RA1=0,RA2=RAIEN702
LOOP1 K RAFDA,RAIEN,RAMSG S RA1=$O(^RAMIS(71,RAPRI,"NUC",RA1)) G:'RA1 EN1Q
 S RA50PTR=+^RAMIS(71,RAPRI,"NUC",RA1,0)
 S RAFDA(70.21,"+2,"_RA2_",",.01)=RA50PTR
 D UPDATE^DIE("","RAFDA","RAIEN","RAMSG") G:'$D(RAMSG) LOOP1
 W !,*7,"  ??",!!,"** Error -- unable to enter default radiopharmaceutical info **",!
 ;keep RAIEN702 as it was, even tho can't insert radiopharm
EN1Q Q RAIEN702
 ;
EN2(RADFN,RADTI,RACNI) ; enter default pharmceutical(s) into subflds of file 70
 Q:'$G(RAPRI)
 N RA1,RA2,RAFDA,RAIEN,RAMSG,DIERR
 N RA50NDE ; Default Medications '0' node for this procedure
 Q:$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0))  ; old data ?
 S RA1=0,RA2=RACNI_","_RADTI_","_RADFN
LOOP2 K RAFDA,RAIEN,RAMSG S RA1=$O(^RAMIS(71,RAPRI,"P",RA1)) G:'RA1 EN2Q
 S RA50NDE=$G(^RAMIS(71,RAPRI,"P",RA1,0))
 S RAFDA(70.15,"+2,"_RA2_",",.01)=+RA50NDE
 S RAFDA(70.15,"+2,"_RA2_",",2)=$P(RA50NDE,"^",2)
 D UPDATE^DIE("","RAFDA","RAIEN","RAMSG")
 G:'$D(RAMSG) LOOP2
 W !,*7,"  ??",!!,"** Error -- unable to enter default pharmaceutical info **",!
EN2Q Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANMPT1   1872     printed  Sep 23, 2025@20:13:34                                                                                                                                                                                                     Page 2
RANMPT1   ;HISC/GJC-Radiopharm interface; ;8/6/97  12:35
 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
 +2       ; 'RAX': Patient IEN, 'RAY': Exam Date (external) ,'RAZ' : Case #  
 +3       ; 'RAIEN702': new IEN in file 70.2
EN1(RAX,RAY,RAZ) ; add minimum entry info into file 70.2
 +1        SET RAIEN702=$ORDER(^RADPTN("AA",RAX,RAY,RAZ,0))
           if RAIEN702
               QUIT RAIEN702
 +2        NEW DIERR,RATMP
 +3        SET RATMP(70.2,"+1,",.01)=RAX
 +4        SET RATMP(70.2,"+1,",2)=RAY
           SET RATMP(70.2,"+1,",3)=RAZ
 +5        DO UPDATE^DIE("","RATMP","RAIEN702")
 +6        SET RAIEN702=$SELECT(+$GET(RAIEN702(1))>0:RAIEN702(1),1:-1)
 +7        IF RAIEN702=-1
               WRITE !,*7,"  ??",!!,"** Error -- Unable to file drug info **",!
               GOTO EN1Q
 +8        NEW RA1,RA2,RAFDA,RAIEN,RAMSG
 +9       ;stuff only during registration
           if '$DATA(RAOPT("REG"))
               QUIT RAIEN702
 +10       if '$GET(RAPRI)
               QUIT RAIEN702
 +11      ; enter default radiopharmaceutical(s) into subflds of file 70.2
 +12       SET RA1=0
           SET RA2=RAIEN702
LOOP1      KILL RAFDA,RAIEN,RAMSG
           SET RA1=$ORDER(^RAMIS(71,RAPRI,"NUC",RA1))
           if 'RA1
               GOTO EN1Q
 +1        SET RA50PTR=+^RAMIS(71,RAPRI,"NUC",RA1,0)
 +2        SET RAFDA(70.21,"+2,"_RA2_",",.01)=RA50PTR
 +3        DO UPDATE^DIE("","RAFDA","RAIEN","RAMSG")
           if '$DATA(RAMSG)
               GOTO LOOP1
 +4        WRITE !,*7,"  ??",!!,"** Error -- unable to enter default radiopharmaceutical info **",!
 +5       ;keep RAIEN702 as it was, even tho can't insert radiopharm
EN1Q       QUIT RAIEN702
 +1       ;
EN2(RADFN,RADTI,RACNI) ; enter default pharmceutical(s) into subflds of file 70
 +1        if '$GET(RAPRI)
               QUIT 
 +2        NEW RA1,RA2,RAFDA,RAIEN,RAMSG,DIERR
 +3       ; Default Medications '0' node for this procedure
           NEW RA50NDE
 +4       ; old data ?
           if $ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0))
               QUIT 
 +5        SET RA1=0
           SET RA2=RACNI_","_RADTI_","_RADFN
LOOP2      KILL RAFDA,RAIEN,RAMSG
           SET RA1=$ORDER(^RAMIS(71,RAPRI,"P",RA1))
           if 'RA1
               GOTO EN2Q
 +1        SET RA50NDE=$GET(^RAMIS(71,RAPRI,"P",RA1,0))
 +2        SET RAFDA(70.15,"+2,"_RA2_",",.01)=+RA50NDE
 +3        SET RAFDA(70.15,"+2,"_RA2_",",2)=$PIECE(RA50NDE,"^",2)
 +4        DO UPDATE^DIE("","RAFDA","RAIEN","RAMSG")
 +5        if '$DATA(RAMSG)
               GOTO LOOP2
 +6        WRITE !,*7,"  ??",!!,"** Error -- unable to enter default pharmaceutical info **",!
EN2Q       QUIT