RAPAST ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Enter Last Visit Date Before DHCP ;9/12/94 11:14
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
S DIC(0)="",DIC="^RAMIS(71,",X="OTHER" D ^DIC K DIC I Y<0 W !,*7,"Procedure used as default is not available!" G Q
S RAPRC=$P(Y,"^",2)
PAT W ! S DIC(0)="AEMQL" D ^RADPA G Q:Y<0 S RADFN=+Y
I $O(^RADPT(RADFN,"DT",0))>0 W !!,*7,"Patient already has a visit logged in for " S Y=9999999.9999-$O(^(0)) D D^RAUTL W Y,".",! K RADFN G PAT
S %DT(0)=-DT,%DT("A")="Last Exam Date before DHCP: ",%DT="AETPX" D ^%DT K %DT G PAT:Y<0 S RADTE=$S(Y[".":Y,1:Y_".0001")
S DA=RADFN,DIE="^RADPT(",DR="[RA LAST PAST VISIT]" D ^DIE K DE,DQ,DIE,DR G PAT
Q K %W,%X,%Y1,D,DI
K %,%DT,%H,%Y,A,C,D0,D1,D2,DA,DIC,DIE,DR,I,RADFN,RADTE,RADTE99,RAPRC,RAPTFL,X,XQUIT,Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPAST 826 printed Nov 22, 2024@17:48:26 Page 2
RAPAST ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Enter Last Visit Date Before DHCP ;9/12/94 11:14
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 DO SET^RAPSET1
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+3 SET DIC(0)=""
SET DIC="^RAMIS(71,"
SET X="OTHER"
DO ^DIC
KILL DIC
IF Y<0
WRITE !,*7,"Procedure used as default is not available!"
GOTO Q
+4 SET RAPRC=$PIECE(Y,"^",2)
PAT WRITE !
SET DIC(0)="AEMQL"
DO ^RADPA
if Y<0
GOTO Q
SET RADFN=+Y
+1 IF $ORDER(^RADPT(RADFN,"DT",0))>0
WRITE !!,*7,"Patient already has a visit logged in for "
SET Y=9999999.9999-$ORDER(^(0))
DO D^RAUTL
WRITE Y,".",!
KILL RADFN
GOTO PAT
+2 SET %DT(0)=-DT
SET %DT("A")="Last Exam Date before DHCP: "
SET %DT="AETPX"
DO ^%DT
KILL %DT
if Y<0
GOTO PAT
SET RADTE=$SELECT(Y[".":Y,1:Y_".0001")
+3 SET DA=RADFN
SET DIE="^RADPT("
SET DR="[RA LAST PAST VISIT]"
DO ^DIE
KILL DE,DQ,DIE,DR
GOTO PAT
Q KILL %W,%X,%Y1,D,DI
+1 KILL %,%DT,%H,%Y,A,C,D0,D1,D2,DA,DIC,DIE,DR,I,RADFN,RADTE,RADTE99,RAPRC,RAPTFL,X,XQUIT,Y
QUIT
