AZCMPR ;CCTHIS IS AN EXAMPLE OF PRINT AZCM(1440069 GLOBAL [ 11/04/91 11:18 AM ]
;10/28/91 4:40 PM
; ;10/24/91 11:13 AM
STUFF ;S DFN="",PO=0
;S PO=$O(^AZCM(1440069,"C",PO)),DFN=$O(^AZCM(1440069,"C",PO,DFN)) Q:+BPO=0
;S BBA=$P(^AZCM(1440069,DFN,0),"^",1) W BA
;S FI=$P(^AZCM(1440069,DFN,1,0),"^",2) W ?5,FI
;S ADATE=$P(^AZCM(1440069,DFN,2,1,0),"^",1) W ?20,ADATE
;S ALLOW=$P(^AZCM(1440069,DFN,2,1,0),"^",2) W ?30,ALLOW
;S CAN=$P(^AZCM(1440069,DFN,1,1,0),"^",1) W ?40,CAN
;S OBJF=$P(^AZCM(1440069,DFN,1,1,1,0),"^",2) W ?45,OBJF
;S OBJ=$P(^AZCM(1440069,DFN,1,1,1,1,0),"^",1) W ?60,OBJ
;S DOCF=$P(^AZCM(1440069,DFN,1,1,1,1,1,0),"^",2) W ?65,DOCF
;S DOC=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,0),"^",1) W !!,?5,DOC
;S OBLG=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,0),"^",2) W ?15,OBLG
;S VENDOR=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,0),"^",5) W ?25,VENDOR
;S PO=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,2),"^",1) W ?35,PO
;S OBDT=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,2),"^",2) W ?50,OBDT
START R "ENTER BEG NO.: ",START:300 Q:'$D(START)
W !!
END R "ENTER ENDING NO. :",END:300 G:((START?.N)&(END'?.N)) START G:((START?1A.E)&(END'?1A.E)) START G:END<START START Q:'$D(END)
S DFN="",BA=0
BEG S BA=$O(^AZCM(1440069,"B",BA)),DFN=$O(^AZCM(1440069,"B",BA,DFN)) G:+BA=0 ADD
DO ;ENTRY POINT FOR SETTING VARIABLES
S CAN=0
CAN S CAN=$O(^AZCM(1440069,DFN,1,CAN)) G:+CAN=0 BEG
S OBJ=0
OBJ S OBJ=$O(^AZCM(1440069,DFN,1,CAN,1,OBJ)) G:+OBJ=0 CAN
S DOBC=0
DOC S DOC=$O(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC)) G:+DOC=0 OBJ
S PO=$P(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC,2),"^",1)
;W !!,PO
S ^AZCMTMPG("B",PO)=PO
G DOC
ADD S X=START
S X=X-1
ADD1 S X=X+1 Q:X>END
I '$D(^AZCMTMPG("B",X)) W !!,"MISSING DOCUMENT NUMBER ",X
G ADD1
Q
K ^AZCMTMPG("B",PO)
AZCMPR ;CCTHIS IS AN EXAMPLE OF PRINT AZCM(1440069 GLOBAL [ 11/04/91 11:18 AM ]
+1 ;10/28/91 4:40 PM
+2 ; ;10/24/91 11:13 AM
STUFF ;S DFN="",PO=0
+1 ;S PO=$O(^AZCM(1440069,"C",PO)),DFN=$O(^AZCM(1440069,"C",PO,DFN)) Q:+BPO=0
+2 ;S BBA=$P(^AZCM(1440069,DFN,0),"^",1) W BA
+3 ;S FI=$P(^AZCM(1440069,DFN,1,0),"^",2) W ?5,FI
+4 ;S ADATE=$P(^AZCM(1440069,DFN,2,1,0),"^",1) W ?20,ADATE
+5 ;S ALLOW=$P(^AZCM(1440069,DFN,2,1,0),"^",2) W ?30,ALLOW
+6 ;S CAN=$P(^AZCM(1440069,DFN,1,1,0),"^",1) W ?40,CAN
+7 ;S OBJF=$P(^AZCM(1440069,DFN,1,1,1,0),"^",2) W ?45,OBJF
+8 ;S OBJ=$P(^AZCM(1440069,DFN,1,1,1,1,0),"^",1) W ?60,OBJ
+9 ;S DOCF=$P(^AZCM(1440069,DFN,1,1,1,1,1,0),"^",2) W ?65,DOCF
+10 ;S DOC=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,0),"^",1) W !!,?5,DOC
+11 ;S OBLG=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,0),"^",2) W ?15,OBLG
+12 ;S VENDOR=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,0),"^",5) W ?25,VENDOR
+13 ;S PO=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,2),"^",1) W ?35,PO
+14 ;S OBDT=$P(^AZCM(1440069,DFN,1,1,1,1,1,1,2),"^",2) W ?50,OBDT
START READ "ENTER BEG NO.: ",START:300
IF '$DATA(START)
QUIT
+1 WRITE !!
END READ "ENTER ENDING NO. :",END:300
IF ((START?.N)&(END'?.N))
GOTO START
IF ((START?1A.E)&(END'?1A.E))
GOTO START
IF END<START
GOTO START
IF '$DATA(END)
QUIT
+1 SET DFN=""
SET BA=0
BEG SET BA=$ORDER(^AZCM(1440069,"B",BA))
SET DFN=$ORDER(^AZCM(1440069,"B",BA,DFN))
IF +BA=0
GOTO ADD
DO ;ENTRY POINT FOR SETTING VARIABLES
+1 SET CAN=0
CAN SET CAN=$ORDER(^AZCM(1440069,DFN,1,CAN))
IF +CAN=0
GOTO BEG
+1 SET OBJ=0
OBJ SET OBJ=$ORDER(^AZCM(1440069,DFN,1,CAN,1,OBJ))
IF +OBJ=0
GOTO CAN
+1 SET DOBC=0
DOC SET DOC=$ORDER(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC))
IF +DOC=0
GOTO OBJ
+1 SET PO=$PIECE(^AZCM(1440069,DFN,1,CAN,1,OBJ,1,DOC,2),"^",1)
+2 ;W !!,PO
+3 SET ^AZCMTMPG("B",PO)=PO
+4 GOTO DOC
ADD SET X=START
+1 SET X=X-1
ADD1 SET X=X+1
IF X>END
QUIT
+1 IF '$DATA(^AZCMTMPG("B",X))
WRITE !!,"MISSING DOCUMENT NUMBER ",X
+2 GOTO ADD1
+3 QUIT
+4 KILL ^AZCMTMPG("B",PO)
+5 +6 +7 +8 +9 +10 +11
***** ERRORS & WARNINGS IN AZCMPR *****
AZCMPR+1 S - 2nd line of routine violates the SAC.
ADD1+5 W - Null line (no commands or comment).
ADD1+6 W - Null line (no commands or comment).
ADD1+7 W - Null line (no commands or comment).
ADD1+8 W - Null line (no commands or comment).
ADD1+9 W - Null line (no commands or comment).
ADD1+10 W - Null line (no commands or comment).
ADD1+11 W - Null line (no commands or comment).
