- 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).
