AZXZSUP3 ;SUPPORT DATABASE PROGRAM[ 05/01/95 1:25 PM ]
;04/22/92 JOHN H. LYNCH
;
;THIS ROUTINE WILL ALLOW A USER TO SEARCH
;FOR ANY WORKING LOGS UNDER THEIR INITIALS
;AND FOR ANY PARTICULAR SET OF DATES.
MAIN ;AZXZSUP3 PROGRAM CONTROL
;INITIALIZE LOCAL VARIABLES
S DA=0 ;INITIALIZE INTERNAL ENTRY NUMBER
S FILE="1991012" ;FILE = FILE NUMBER (SUPPDB)
S DIC="^DIZ(FILE," ;DIC = FILE NAME (SUPPDB)
S DR=".01:7" ;WRITE ALL FIELDS TO TEMP. GLOBAL (TMPGBL)
D WORKPRNT
I (INIT'="^") R !!,"Do you want to print another Working Log? Y// ",YN
I YN="" S YN="Y"
I YN="Y" G MAIN
K DA,DIC,DR,YN,INIT,LDATE,X,UDATE,L
K FR,FLDS,BY,DIS(0),DIS(1),DIC(0),%DT
Q
WORKPRNT ;PRINTOUT WORKING LOG
;CLEAR SCREEN
W @IOF
W !!!,"Working Log Print..."
W !!!! H 1
SELECT ;ALLOWS USER TO INPUT WHAT TO INCLUDE
;IN WORKING LOG PRINTOUT
R !,"Select Initials: ",INIT
;IF "^" OR "" QUIT AND RETURN TO MAINMENU
I (INIT="^")!(INIT="") S YN="N" Q
;IF "?" GIVE HELP AND RETURN TO SELECT SUB-ROUTINE
I INIT="?" W !!,"Please enter the initials you want to print out on Working Log Print",! G SELECT
;CHECK FOR VALID INITIALS
I INIT'?2.3U W !!,"Initials must be 2-3 Upper Case Alpha Characters.",!,*7 G SELECT
D INITLKUP ;CHECK TO SEE IF INITIALS MATCH WHAT IS IN INITIALS FILE
I INIT<1 W !!,"Initials are not on file in the INITIALS file.",!,*7 G SELECT
;IF THEY ARE ON FILE CONTINUE, OTHERWISE FLAG THEM AND G SELECT
LBDATE R !,"Select Lower Boundary Date :",LDATE
;IF "^" RETURN TO PREVIOUS PROMPT (SELECT)
I LDATE="^" G WORKPRNT
;IF "" SET LDATE = LOWEST DATE POSSIBLE & UDATE = CURRENT DATE
;GO RIGHT TO PRINTOUT; THEN QUIT
I LDATE="" D DEFAULT D PRINTOUT Q
;IF "?" GIVE HELP AND RETURN TO LDATE PROMPT
I LDATE="?" W !!,"Give the lower boundary date for Working Log Printout",!,"OR press return to receive ALL working logs [mm/dd/yy].",! G LBDATE
;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED
I LDATE'?2N1"/"2N1"/"2N W !!,"Illegal date; check format and re-enter lower boundary date.",!,*7 G LBDATE
;CONVERT DATE (CONVERT)
S X=LDATE ;X = DATE TO CONVERT USING ^%DT
D CONVERT
;DATE FORMAT WAS ILLEGAL
I Y<1 W !!,"Illegal date; check format and re-enter upper boundary date.",!,*7 G LBDATE
S LDATE=Y
UBDATE R !,"Select Upper Boundary Date :",UDATE
;IF "^" RETURN TO PREVIOUS PROMPT (LBDATE)
I UDATE="^" G LBDATE
;IF "" WRITE "UPPER BOUNDARY MUST BE ENTERED"
I UDATE="" W !!,"An upper boundary date must be entered when a lower limit has been given.",!,*7 G UBDATE
;IF "?" GIVE HELP AND RETURN TO LDATE PROMPT
I UDATE="?" W !!,"Give the upper boundary date for Working Log Printout [mm/dd/yy].",! G UBDATE
;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED
I UDATE'?2N1"/"2N1"/"2N W !!,"Illegal date; check format and re-enter upper boundary date.",!,*7 G UBDATE
;CONVERT DATE (CONVERT)
S X=UDATE ;X = DATE TO CONVERT USING ^%DT
D CONVERT
;DATE FORMAT WAS ILLEGAL
I Y<1 W !!,"Illegal date; check format and re-enter upper boundary date.",!,*7 G UBDATE
S UDATE=Y
;CHECK TO SEE IF UDATE >= LDATE
I UDATE'>LDATE!UDATE=LDATE W !!,"Upper boundary date must be greater than or equal to lower boundary date.",!,*7 G UBDATE
;DO PRINTOUT; THEN QUIT
D PRINTOUT
Q
PRINTOUT ;PRINTOUT WORKING LOG LIST USING FILEMAN'S DIP ROUTINE
S L=0,FR=""
S DIC="^DIZ(FILE," ;FILE NUMBER FOR SUPPDB
S FLDS="[PRNTWORK]" ;PRINT TEMPLATE
S BY="[SRCHWORK]" ;SEARCH (SORT) TEMPLATE
;SORT TEMPLATE SETTING DIS(0) TO CHECK FOR WORKING LOGS BETWEEN DATES
S DIS(0)="S STATUS=0,OCCUR=0,STATUS=$O(^DIZ(FILE,D0,1,""B"",""W"",STATUS)) I STATUS'="""" I $O(^DIZ(FILE,""C"",INIT,D0,STATUS,OCCUR)) I ($J($P(^DIZ(FILE,D0,0),U,4),7,0)'<LDATE)&($J($P(^DIZ(FILE,D0,0),U,4),7,0)'>UDATE)"
;SORT TEMPLATE SETTING DIS(1) TO CHECK FOR NON-CLOSED LOGS
S DIS(1)="S STATUS2=0 I '$O(^DIZ(FILE,D0,1,""B"",""C"",STATUS2))"
D EN1^DIP ;CALL DIP ROUTINE
Q
DEFAULT ;SET DEFAULT DATES TO INCLUDE ALL CURRENT LOGS
S LDATE="2920401" ;SET TO EARLIER THAN EARLIEST POSSIBLE LOG DATE
S UDATE=DT ;SET TO CURRENT DATE
Q
INITLKUP ;CHECK TO MAKE SURE USER INPUT OF INITIALS ARE ON FILE IN 'INITIALS'
S DIC="^DIZ(1991016," ;SET DIC="INITIALS FILE"
S X=INIT ;SET X = INITIALS GIVEN BY USER
S DIC(0)="XZ" ;X = EXACT MATCH, Z = SET Y NODES
D ^DIC ;CALL FILEMAN LOOKUP ROUTINE (DIC)
S INIT=$P(Y,U,1) ;SET INIT TO INTERNAL NUMBER FOR INITIALS
Q
CONVERT ;CONVERT USER DATES TO FILEMAN DATE FORMAT
;SET LOCAL VARIABLES
S %DT="EXT" ;E=ECHO ANSWER;X=EXACT DATE;T=TIME ALLOWED, NOT REQUIRED
D ^%DT ;VALUE RETURNED IN Y
Q
AZXZSUP3 ;SUPPORT DATABASE PROGRAM[ 05/01/95 1:25 PM ]
+1 ;04/22/92 JOHN H. LYNCH
+2 ;
+3 ;THIS ROUTINE WILL ALLOW A USER TO SEARCH
+4 ;FOR ANY WORKING LOGS UNDER THEIR INITIALS
+5 ;AND FOR ANY PARTICULAR SET OF DATES.
+6 MAIN ;AZXZSUP3 PROGRAM CONTROL
+1 ;INITIALIZE LOCAL VARIABLES
+2 ;INITIALIZE INTERNAL ENTRY NUMBER
SET DA=0
+3 ;FILE = FILE NUMBER (SUPPDB)
SET FILE="1991012"
+4 ;DIC = FILE NAME (SUPPDB)
SET DIC="^DIZ(FILE,"
+5 ;WRITE ALL FIELDS TO TEMP. GLOBAL (TMPGBL)
SET DR=".01:7"
+6 +7 DO WORKPRNT
+8 IF (INIT'="^")
READ !!,"Do you want to print another Working Log? Y// ",YN
+9 IF YN=""
SET YN="Y"
+10 IF YN="Y"
GOTO MAIN
+11 KILL DA,DIC,DR,YN,INIT,LDATE,X,UDATE,L
+12 KILL FR,FLDS,BY,DIS(0),DIS(1),DIC(0),%DT
+13 QUIT
+14 WORKPRNT ;PRINTOUT WORKING LOG
+1 +2 ;CLEAR SCREEN
+3 WRITE @IOF
+4 +5 WRITE !!!,"Working Log Print..."
+6 WRITE !!!!
HANG 1
+7 SELECT ;ALLOWS USER TO INPUT WHAT TO INCLUDE
+1 ;IN WORKING LOG PRINTOUT
+2 +3 READ !,"Select Initials: ",INIT
+4 +5 ;IF "^" OR "" QUIT AND RETURN TO MAINMENU
+6 IF (INIT="^")!(INIT="")
SET YN="N"
QUIT
+7 +8 ;IF "?" GIVE HELP AND RETURN TO SELECT SUB-ROUTINE
+9 IF INIT="?"
WRITE !!,"Please enter the initials you want to print out on Working Log Print",!
GOTO SELECT
+10 +11 ;CHECK FOR VALID INITIALS
+12 IF INIT'?2.3U
WRITE !!,"Initials must be 2-3 Upper Case Alpha Characters.",!,*7
GOTO SELECT
+13 ;CHECK TO SEE IF INITIALS MATCH WHAT IS IN INITIALS FILE
DO INITLKUP
+14 IF INIT<1
WRITE !!,"Initials are not on file in the INITIALS file.",!,*7
GOTO SELECT
+15 ;IF THEY ARE ON FILE CONTINUE, OTHERWISE FLAG THEM AND G SELECT
+16 LBDATE READ !,"Select Lower Boundary Date :",LDATE
+1 +2 ;IF "^" RETURN TO PREVIOUS PROMPT (SELECT)
+3 IF LDATE="^"
GOTO WORKPRNT
+4 +5 ;IF "" SET LDATE = LOWEST DATE POSSIBLE & UDATE = CURRENT DATE
+6 ;GO RIGHT TO PRINTOUT; THEN QUIT
+7 IF LDATE=""
DO DEFAULT
DO PRINTOUT
QUIT
+8 +9 ;IF "?" GIVE HELP AND RETURN TO LDATE PROMPT
+10 IF LDATE="?"
WRITE !!,"Give the lower boundary date for Working Log Printout",!,"OR press return to receive ALL working logs [mm/dd/yy].",!
GOTO LBDATE
+11 +12 ;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED
+13 IF LDATE'?2N1"/"2N1"/"2N
WRITE !!,"Illegal date; check format and re-enter lower boundary date.",!,*7
GOTO LBDATE
+14 +15 ;CONVERT DATE (CONVERT)
+16 ;X = DATE TO CONVERT USING ^%DT
SET X=LDATE
+17 DO CONVERT
+18 ;DATE FORMAT WAS ILLEGAL
+19 IF Y<1
WRITE !!,"Illegal date; check format and re-enter upper boundary date.",!,*7
GOTO LBDATE
+20 SET LDATE=Y
+21 UBDATE READ !,"Select Upper Boundary Date :",UDATE
+1 +2 ;IF "^" RETURN TO PREVIOUS PROMPT (LBDATE)
+3 IF UDATE="^"
GOTO LBDATE
+4 +5 ;IF "" WRITE "UPPER BOUNDARY MUST BE ENTERED"
+6 IF UDATE=""
WRITE !!,"An upper boundary date must be entered when a lower limit has been given.",!,*7
GOTO UBDATE
+7 +8 ;IF "?" GIVE HELP AND RETURN TO LDATE PROMPT
+9 IF UDATE="?"
WRITE !!,"Give the upper boundary date for Working Log Printout [mm/dd/yy].",!
GOTO UBDATE
+10 +11 ;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED
+12 IF UDATE'?2N1"/"2N1"/"2N
WRITE !!,"Illegal date; check format and re-enter upper boundary date.",!,*7
GOTO UBDATE
+13 +14 ;CONVERT DATE (CONVERT)
+15 ;X = DATE TO CONVERT USING ^%DT
SET X=UDATE
+16 DO CONVERT
+17 ;DATE FORMAT WAS ILLEGAL
+18 IF Y<1
WRITE !!,"Illegal date; check format and re-enter upper boundary date.",!,*7
GOTO UBDATE
+19 SET UDATE=Y
+20 +21 ;CHECK TO SEE IF UDATE >= LDATE
+22 IF UDATE'>LDATE!UDATE=LDATE
WRITE !!,"Upper boundary date must be greater than or equal to lower boundary date.",!,*7
GOTO UBDATE
+23 +24 ;DO PRINTOUT; THEN QUIT
+25 DO PRINTOUT
+26 QUIT
+27 PRINTOUT ;PRINTOUT WORKING LOG LIST USING FILEMAN'S DIP ROUTINE
+1 SET L=0
SET FR=""
+2 ;FILE NUMBER FOR SUPPDB
SET DIC="^DIZ(FILE,"
+3 ;PRINT TEMPLATE
SET FLDS="[PRNTWORK]"
+4 ;SEARCH (SORT) TEMPLATE
SET BY="[SRCHWORK]"
+5 ;SORT TEMPLATE SETTING DIS(0) TO CHECK FOR WORKING LOGS BETWEEN DATES
+6 SET DIS(0)="S STATUS=0,OCCUR=0,STATUS=$O(^DIZ(FILE,D0,1,""B"",""W"",STATUS)) I STATUS'="""" I $O(^DIZ(FILE,""C"",INIT,D0,STATUS,OCCUR)) I ($J($P(^DIZ(FILE,D0,0),U,4),7,0)'<LDATE)&($J($P(^DIZ(FILE,D0,0),U,4),7,0)'>UDATE)"
+7 ;SORT TEMPLATE SETTING DIS(1) TO CHECK FOR NON-CLOSED LOGS
+8 SET DIS(1)="S STATUS2=0 I '$O(^DIZ(FILE,D0,1,""B"",""C"",STATUS2))"
+9 ;CALL DIP ROUTINE
DO EN1^DIP
+10 QUIT
+11 DEFAULT ;SET DEFAULT DATES TO INCLUDE ALL CURRENT LOGS
+1 ;SET TO EARLIER THAN EARLIEST POSSIBLE LOG DATE
SET LDATE="2920401"
+2 ;SET TO CURRENT DATE
SET UDATE=DT
+3 QUIT
INITLKUP ;CHECK TO MAKE SURE USER INPUT OF INITIALS ARE ON FILE IN 'INITIALS'
+1 ;SET DIC="INITIALS FILE"
SET DIC="^DIZ(1991016,"
+2 ;SET X = INITIALS GIVEN BY USER
SET X=INIT
+3 ;X = EXACT MATCH, Z = SET Y NODES
SET DIC(0)="XZ"
+4 ;CALL FILEMAN LOOKUP ROUTINE (DIC)
DO ^DIC
+5 ;SET INIT TO INTERNAL NUMBER FOR INITIALS
SET INIT=$PIECE(Y,U,1)
+6 QUIT
+7 CONVERT ;CONVERT USER DATES TO FILEMAN DATE FORMAT
+1 ;SET LOCAL VARIABLES
+2 ;E=ECHO ANSWER;X=EXACT DATE;T=TIME ALLOWED, NOT REQUIRED
SET %DT="EXT"
+3 ;VALUE RETURNED IN Y
DO ^%DT
+4 QUIT
