AZCMPR.m

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