DVBAADMR.m

DVBAADMR ;ALB ISC/THM-ADMISSION REVIEW FOR AMIE ;21 JUL 89;

 ;;2.7;AMIE;;Apr 10, 1995

 D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL

 S LN="ADMISSION REVIEW REPORT" D HOME^%ZIS

 ;

EN1 S %DT(0)=-DT W @IOF,!?(IOM-$L(LN)\2),LN,!!! S %DT="AE",%DT("A")="Enter ADMISSION REVIEW DATE: " D ^%DT S RVDT=Y K %DT(0)

 I +Y<0 G END

 W *7,!!,"Note:  This program requires 132 columns to correctly print the report.",!!

 D PRINT

 I $D(IOST) I IOST?1"C-".E W !!,"Press [RETURN] to continue or ""^"" to exit    " R ANS:DTIME I ANS=U!('$T) G END

 G EN1

 ;

END K %DT,RVDT,FR,TO,L,DIC,ANS,DIJ,DP,P,X,Y,LN,IOY,DA,DO,C,D,DE,DHD,DIK,DIS,I,J,K,IOP,BY,FLDS

 W @IOF,! Q

 ;

PRINT S DHD="Admission Review Report for "_$P(^DVB(396.1,1,0),U,1)_" for " S Y=RVDT X ^DD("DD") S DHD=DHD_Y,L=0,DIC="^DGPM(",FR=RVDT,TO=RVDT,BY="[DVBA ADMISSION REVIEW]",FLDS="[DVBA ADMISSION REVIEW]" D EN1^DIP Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBAADMR   877     printed  Apr 09, 2024@20:53:10                                                                                                                                                                                                     Page 2

DVBAADMR  ;ALB ISC/THM-ADMISSION REVIEW FOR AMIE ;21 JUL 89;

 +1       ;;2.7;AMIE;;Apr 10, 1995

 +2        DO NOPARM^DVBAUTL2

           if $DATA(DVBAQUIT)

               GOTO KILL^DVBAUTIL

 +3        SET LN="ADMISSION REVIEW REPORT"

           DO HOME^%ZIS

 +4       ;

EN1        SET %DT(0)=-DT

           WRITE @IOF,!?(IOM-$LENGTH(LN)\2),LN,!!!

           SET %DT="AE"

           SET %DT("A")="Enter ADMISSION REVIEW DATE: "

           DO ^%DT

           SET RVDT=Y

           KILL %DT(0)

 +1        IF +Y<0

               GOTO END

 +2        WRITE *7,!!,"Note:  This program requires 132 columns to correctly print the report.",!!

 +3        DO PRINT

 +4        IF $DATA(IOST)

               IF IOST?1"C-".E

                   WRITE !!,"Press [RETURN] to continue or ""^"" to exit    "

                   READ ANS:DTIME

                   IF ANS=U!('$TEST)

                       GOTO END

 +5        GOTO EN1

 +6       ;

END        KILL %DT,RVDT,FR,TO,L,DIC,ANS,DIJ,DP,P,X,Y,LN,IOY,DA,DO,C,D,DE,DHD,DIK,DIS,I,J,K,IOP,BY,FLDS

 +1        WRITE @IOF,!

           QUIT 

 +2       ;

PRINT      SET DHD="Admission Review Report for "_$PIECE(^DVB(396.1,1,0),U,1)_" for "

           SET Y=RVDT

           XECUTE ^DD("DD")

           SET DHD=DHD_Y

           SET L=0

           SET DIC="^DGPM("

           SET FR=RVDT

           SET TO=RVDT

           SET BY="[DVBA ADMISSION REVIEW]"

           SET FLDS="[DVBA ADMISSION REVIEW]"

           DO EN1^DIP

           QUIT