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 Dec 13, 2024@02:37:29 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
