APCHS12A.m

APCHS12A ; IHS/CMI/LAB - PART 12A OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ; ********** FLOWSHEET PRODUCTION **********

FLOWD ;ENTRY POINT

 S Y=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y

 S APCHSP="",$P(APCHSP,"-",APCHSMXL+9)="" X APCHSCKP Q:$D(APCHSQIT)  W:'APCHSNPG ?2,APCHSP,! D:APCHSNPG FLOWHD^APCHS12

 D FLOWCKP^APCHS12 Q:$D(APCHSQIT)

 W ?2,APCHSDAT

 F APCHSI=0:0 S APCHSI=$O(APCHSDB(APCHSI)) Q:'APCHSI  D FLOWCKP^APCHS12 Q:$D(APCHSQIT)  D FLOWD2 W !

 Q

FLOWD2 F APCHSJ=0:0 S APCHSJ=$O(APCHSTB(APCHSJ)) Q:'APCHSJ  W ?11+APCHSTB(APCHSJ),":",$G(APCHSDB(APCHSI,APCHSJ))

 Q

APCHS12A  ; IHS/CMI/LAB - PART 12A OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ; ********** FLOWSHEET PRODUCTION **********

FLOWD     ;ENTRY POINT

 +1        SET Y=-APCHSIVD\1+9999999

           XECUTE APCHSCVD

           SET APCHSDAT=Y

 +2        SET APCHSP=""

           SET $PIECE(APCHSP,"-",APCHSMXL+9)=""

           XECUTE APCHSCKP

           IF $DATA(APCHSQIT)

               QUIT 

           IF 'APCHSNPG

               WRITE ?2,APCHSP,!

           IF APCHSNPG

               DO FLOWHD^APCHS12

 +3        DO FLOWCKP^APCHS12

           IF $DATA(APCHSQIT)

               QUIT 

 +4        WRITE ?2,APCHSDAT

 +5        FOR APCHSI=0:0

               SET APCHSI=$ORDER(APCHSDB(APCHSI))

               IF 'APCHSI

                   QUIT 

               DO FLOWCKP^APCHS12

               IF $DATA(APCHSQIT)

                   QUIT 

               DO FLOWD2

               WRITE !

 +6        QUIT 

FLOWD2     FOR APCHSJ=0:0

               SET APCHSJ=$ORDER(APCHSTB(APCHSJ))

               IF 'APCHSJ

                   QUIT 

               WRITE ?11+APCHSTB(APCHSJ),":",$GET(APCHSDB(APCHSI,APCHSJ))

 +1        QUIT