RAPAST.m

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 ---RAPAST   826     printed  Apr 09, 2024@21:38:47                                                                                                                                                                                                       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