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 ---[H[J[2J[HDVBAADMR 877 printed Dec 13, 2024@01:40:14 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
