AZCMDOC ;THIS ROUTINE ALLOWS A SEARCH OF THE PURCHASE [ 11/05/91 9:25 AM ]
;ORDER FIELD OF THE COMMITMENT REGISTER PACKAGE AZCM(1440069
;IT MAY BE UTILIZED TO ENTER A RANGE OF PO'S AND WILL
;THEN SEARCH THIS FIELD AND PRINT POSSIBLE MISSING
;PURCHASE ORDERS/DOCUMENTS NOT IN SEQUENTIAL ORDER
;10/22/91B 1:31 PM
HDR D ^AUCLS
W !," ****************SEARCH MISSING DOCUMENTS**********************"
W !!!," THIS OPTION ALLOWS THE USER TO ENTER A RANGE OF DOCUMENTS"
W !," A SEARCH OF THAT RANGE WILL OCCUR AND A LISTING OF POSSIBLE"
W !," MISSING DOCUMENTS (NOT FOUND IN THAT RANGE) WILL BE PRINTED"
W !," **NOTE: DOCUMENTS MUST BE ENTERED IN SEQUENTIAL ORDER!**"
W !," **NOTE: TO ESCAPE PRINTING (HOLD CTRL AND C KEY DOWN)***"
W !!!," *************************************************************"
W !!!
START R "ENTER A BEGINNING DOCUMENT RANGE: ",START:300 G:START["?" MESG G:START="^" END Q:'$D(START)
W !!
START2 R "ENTER AN ENDING DOCUMENT RANGE: ",END:300 G:END["?" MESG2 G:END="^" END G:END<START MESG G:(START?1A.E&(END'?1A.E))!(START'?1A.E&(END?1A.E)) MESG G:(START?1N.E&(END'?1N.E))!(START'?1N.E&(END?1N.E)) MESG Q:'$D(END)
;SET TO VARIABLE DFN
S BA=0
BEG S BA=$O(^AZCM(1440069,"B",BA)) G:+BA=0 ADD
S DFN=""
DFN S DFN=$O(^AZCM(1440069,"B",BA,DFN)) G:+DFN=0 BEG
S CAN=0
CAN S CAN=$O(^AZCM(1440069,DFN,1,CAN)) G:+CAN=0 DFN
S OBJ=0
OBJ S OBJ=$O(^AZCM(1440069,DFN,1,CAN,1,OBJ)) G:+OBJ=0 CAN
S DOC=0
DOC S DOC=$O(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC)) G:+DOC=0 OBJ
;SET PRINTING VARIABLES
S PO=$P(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC,2),"^",1)
S BA=$P(^AZCM(1440069,DFN,0),"^",1)
;W !!,?5,BA W ?10,PO
S ^AZCMTMPG("B",PO)=""
G DOC
ADD S X=START
S X=X-1
W !! F I=1:1:75 W "!"
W !!,"**THE BEGINNING DOCUMENT NUMBER IS: ",START
W !!,"**THE ENDING DOCUMENT NUMBER IS: ",END
W !!
ASK R !,"DO YOU WISH TO CONTINUE? (Y/N): ",ANS G:ANS["?" HELP G:(ANS="N"!(ANS="NO")) MESG3 G:(ANS="Y"!(ANS="YES")) ADD1 G:(ANS'="N"!(ANS'="NO")) ASK G:(ANS'="Y"!(ANS'="YES")) ASK
ADD1 S X=X+1 G:X>END FEND
I '$D(^AZCMTMPG("B",X)) W !!," MISSING DOCUMENT NUMBER ",X
G ADD1
MESG D ^AUCLS
W ! F I=1:1:75 W "*"
W *7,*7,*7,!," THE BEGINNING AND ENDING NUMBERS MUST BE ENTERED IN A SEQUENTIAL"
W !," FORMAT - EXAMPLE (BEGINNING = 123) (ENDING = 125), ETC."
W !," OR BR-123 BR=125 ETC."
W !," THE ENDING NUMBER MUST BE LARGER THAN BEGINNING NUMBER"
W !," IF AN ALPHA CHARACTER IS USED IN THE BEGINNING NUMBER,"
W !," IT MUST ALSO BE USED IN THE ENDING NUMBER SEQUENCE."
W !," THE SEARCH WILL THEN LOOK FOR ANY DOCUMENT MISSING BETWEEN THESE"
W !," TWO NUMBERS AND PRINT ONLY THE MISSING DOCUMENT NUMBER."
W !," ***TO ESCAPE PRINTING - HOLD THE CTRL KEY AND C KEY DOWN***"
W !
W ! F I=1:1:75 W "*"
W !! G START
MESG2 D ^AUCLS
W !! F I=1:1:75 W "*"
W *7,*7,*7,!," THE BEGINNING AND ENDING NUMBERS MUST BE ENTERED IBN A SEQUENTIAL"
W !," FORMAT - EXAMPLE (BEGINNING = 123) (ENDING = 125), ETC."
W !," THE SEARCH WILL THEN LOOK FOR ANY DOCUMENT MISSING BETWEEN THESE"
W !," OR BR-123 THROUGH BR-125 ETC."
W !," TWO NUMBERS AND PRINT ONLY THE MISSING DOCUMENT NUMBER."
W !
W ! F I=1:1:75 W "*"
W !! G START2
MESG3 D ^AUCLS
R !,"WELL THEN DO YOU WISH TO EXIT? (Y/N): ",ANS2 G:ANS2["?" HELP1 G:(ANS2="N"!(ANS2="NO")) MESG G:(ANS2="Y"!(ANS2="YES")) END G:(ANS2'="N"!(ANS2'="NO")) HELP1 G:(ANS2'="Y"!(ANS2'="YES")) HELP1
HELP W !,"ENTER YES OR NO" G ASK
HELP1 W !,"ENTER YES OR NO" H 2 W ! G MESG3
END W *7,*7,*7,!!,"**********ABORTED***NO SEARCH PROCESSED" F I=1:1:40 W "*"
H 5
D ^AUCLS
FEND W !!,"**************FINISHED*********************"
K ^AZCMTMPG
W !!
Q
AZCMDOC ;THIS ROUTINE ALLOWS A SEARCH OF THE PURCHASE [ 11/05/91 9:25 AM ]
+1 ;ORDER FIELD OF THE COMMITMENT REGISTER PACKAGE AZCM(1440069
+2 ;IT MAY BE UTILIZED TO ENTER A RANGE OF PO'S AND WILL
+3 ;THEN SEARCH THIS FIELD AND PRINT POSSIBLE MISSING
+4 ;PURCHASE ORDERS/DOCUMENTS NOT IN SEQUENTIAL ORDER
+5 ;10/22/91B 1:31 PM
HDR DO ^AUCLS
+1 WRITE !," ****************SEARCH MISSING DOCUMENTS**********************"
+2 WRITE !!!," THIS OPTION ALLOWS THE USER TO ENTER A RANGE OF DOCUMENTS"
+3 WRITE !," A SEARCH OF THAT RANGE WILL OCCUR AND A LISTING OF POSSIBLE"
+4 WRITE !," MISSING DOCUMENTS (NOT FOUND IN THAT RANGE) WILL BE PRINTED"
+5 WRITE !," **NOTE: DOCUMENTS MUST BE ENTERED IN SEQUENTIAL ORDER!**"
+6 WRITE !," **NOTE: TO ESCAPE PRINTING (HOLD CTRL AND C KEY DOWN)***"
+7 WRITE !!!," *************************************************************"
+8 WRITE !!!
START READ "ENTER A BEGINNING DOCUMENT RANGE: ",START:300
IF START["?"
GOTO MESG
IF START="^"
GOTO END
IF '$DATA(START)
QUIT
+1 WRITE !!
START2 READ "ENTER AN ENDING DOCUMENT RANGE: ",END:300
IF END["?"
GOTO MESG2
IF END="^"
GOTO END
IF END<START
GOTO MESG
IF (START?1A.E&(END'?1A.E))!(START'?1A.E&(END?1A.E))
GOTO MESG
IF (START?1N.E&(END'?1N.E))!(START'?1N.E&(END?1N.E))
GOTO MESG
IF '$DATA(END)
QUIT
+1 ;SET TO VARIABLE DFN
+2 SET BA=0
BEG SET BA=$ORDER(^AZCM(1440069,"B",BA))
IF +BA=0
GOTO ADD
+1 SET DFN=""
DFN SET DFN=$ORDER(^AZCM(1440069,"B",BA,DFN))
IF +DFN=0
GOTO BEG
+1 SET CAN=0
CAN SET CAN=$ORDER(^AZCM(1440069,DFN,1,CAN))
IF +CAN=0
GOTO DFN
+1 SET OBJ=0
OBJ SET OBJ=$ORDER(^AZCM(1440069,DFN,1,CAN,1,OBJ))
IF +OBJ=0
GOTO CAN
+1 SET DOC=0
DOC SET DOC=$ORDER(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC))
IF +DOC=0
GOTO OBJ
+1 ;SET PRINTING VARIABLES
+2 SET PO=$PIECE(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC,2),"^",1)
+3 SET BA=$PIECE(^AZCM(1440069,DFN,0),"^",1)
+4 ;W !!,?5,BA W ?10,PO
+5 SET ^AZCMTMPG("B",PO)=""
+6 GOTO DOC
ADD SET X=START
+1 SET X=X-1
+2 WRITE !!
FOR I=1:1:75
WRITE "!"
+3 WRITE !!,"**THE BEGINNING DOCUMENT NUMBER IS: ",START
+4 WRITE !!,"**THE ENDING DOCUMENT NUMBER IS: ",END
+5 WRITE !!
ASK READ !,"DO YOU WISH TO CONTINUE? (Y/N): ",ANS
IF ANS["?"
GOTO HELP
IF (ANS="N"!(ANS="NO"))
GOTO MESG3
IF (ANS="Y"!(ANS="YES"))
GOTO ADD1
IF (ANS'="N"!(ANS'="NO"))
GOTO ASK
IF (ANS'="Y"!(ANS'="YES"))
GOTO ASK
ADD1 SET X=X+1
IF X>END
GOTO FEND
+1 IF '$DATA(^AZCMTMPG("B",X))
WRITE !!," MISSING DOCUMENT NUMBER ",X
+2 GOTO ADD1
MESG DO ^AUCLS
+1 WRITE !
FOR I=1:1:75
WRITE "*"
+2 WRITE *7,*7,*7,!," THE BEGINNING AND ENDING NUMBERS MUST BE ENTERED IN A SEQUENTIAL"
+3 WRITE !," FORMAT - EXAMPLE (BEGINNING = 123) (ENDING = 125), ETC."
+4 WRITE !," OR BR-123 BR=125 ETC."
+5 WRITE !," THE ENDING NUMBER MUST BE LARGER THAN BEGINNING NUMBER"
+6 WRITE !," IF AN ALPHA CHARACTER IS USED IN THE BEGINNING NUMBER,"
+7 WRITE !," IT MUST ALSO BE USED IN THE ENDING NUMBER SEQUENCE."
+8 WRITE !," THE SEARCH WILL THEN LOOK FOR ANY DOCUMENT MISSING BETWEEN THESE"
+9 WRITE !," TWO NUMBERS AND PRINT ONLY THE MISSING DOCUMENT NUMBER."
+10 WRITE !," ***TO ESCAPE PRINTING - HOLD THE CTRL KEY AND C KEY DOWN***"
+11 WRITE !
+12 WRITE !
FOR I=1:1:75
WRITE "*"
+13 WRITE !!
GOTO START
MESG2 DO ^AUCLS
+1 WRITE !!
FOR I=1:1:75
WRITE "*"
+2 WRITE *7,*7,*7,!," THE BEGINNING AND ENDING NUMBERS MUST BE ENTERED IBN A SEQUENTIAL"
+3 WRITE !," FORMAT - EXAMPLE (BEGINNING = 123) (ENDING = 125), ETC."
+4 WRITE !," THE SEARCH WILL THEN LOOK FOR ANY DOCUMENT MISSING BETWEEN THESE"
+5 WRITE !," OR BR-123 THROUGH BR-125 ETC."
+6 WRITE !," TWO NUMBERS AND PRINT ONLY THE MISSING DOCUMENT NUMBER."
+7 WRITE !
+8 WRITE !
FOR I=1:1:75
WRITE "*"
+9 WRITE !!
GOTO START2
MESG3 DO ^AUCLS
+1 READ !,"WELL THEN DO YOU WISH TO EXIT? (Y/N): ",ANS2
IF ANS2["?"
GOTO HELP1
IF (ANS2="N"!(ANS2="NO"))
GOTO MESG
IF (ANS2="Y"!(ANS2="YES"))
GOTO END
IF (ANS2'="N"!(ANS2'="NO"))
GOTO HELP1
IF (ANS2'="Y"!(ANS2'="YES"))
GOTO HELP1
HELP WRITE !,"ENTER YES OR NO"
GOTO ASK
HELP1 WRITE !,"ENTER YES OR NO"
HANG 2
WRITE !
GOTO MESG3
END WRITE *7,*7,*7,!!,"**********ABORTED***NO SEARCH PROCESSED"
FOR I=1:1:40
WRITE "*"
+1 HANG 5
+2 DO ^AUCLS
FEND WRITE !!,"**************FINISHED*********************"
+1 KILL ^AZCMTMPG
+2 WRITE !!
+3 QUIT
+4
***** ERRORS & WARNINGS IN AZCMDOC *****
AZCMDOC+1 S - 2nd line of routine violates the SAC.
FEND+1 S - Kill of an unsubscripted global.
FEND+4 W - Null line (no commands or comment).
