ADEKRP6.m

ADEKRP6 ; IHS/HQT/MJL - PRINT COMPILED REPORTS ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 ;

 ;

 ;Process from ^ADEKNT to create report array ADEREP(

 ;ADEYQ=Year.Quarter ADEIEN=IEN in ^ADEKOB file

 ;ADEREP(REPORT TYPE,ADEIEN)=OBJECTIVE NAME

 ;ADEREP(SQ,ADEIEN,AGE)=3YU^D3YU^DVIS3MON^ASSESSD3MON^NUMBER

 ;ADEREP(CQ,ADEIEN,ADEYQ,AGE)=3YU^D3YU^DVIS3MON^ASSESSD3MON^NUMBER

 ;ADEREP(SA,ADEIEN,AGE)=3YU,D3YU,DVIS12MON^ASD12MON^NUM

 ;ADEREP(CA,ADEIEN,AGE)=3YU,D3YU,DVIS12MON^ASD12MON^NUM

 ;

SINGLE(ADEPER,ADEYQ) ;EP

 ;ADEPER="SQ","CQ","SA" OR "CA"

 ;for Single or Combined, Quarterly or Annual

 ;

 ;For each objective in REPORT ORDER xref of ^ADEKOB

 N J,ADEORD,ADENOD,ADEIEN,ADEOBJN,ADEAGEG,ADEAGES,ADEM,ADEMQ,ADEMY,ADEM3,ADED,ADEDQ,ADEDY,ADED3,ADEA,ADEAQ,ADEAY,ADEA3,ADEC,ADECQ,ADECY,ADEC3

 S ADEORD=0

 F  S ADEORD=$O(^ADEKOB("AC",ADEORD)) Q:'+ADEORD  D

 . S ADEIEN=$O(^ADEKOB("AC",ADEORD,0))

 . S ADENOD=^ADEKOB(ADEIEN,0)

 . S ADEOBJN=$P(ADENOD,U)

 . S ^TMP("ADEP",ADEU,ADEPER,ADEIEN)=ADEOBJN

 . S ADEAGES=$P(ADENOD,U,$S(ADEPER["S":3,1:2))

 . I ADEAGES="EACH" D

 . . N J

 . . S ADEAGES=""

 . . F J=0:1:74 S $P(ADEAGES,";",J+1)=J_":"_J

 . . S $P(ADEAGES,";",76)="75:125"

 . ;For each age in CountAges (Single rpts) or MonitorAges (Combined)

 . ;Get 3yu, d3yu, d3monu, ass3mon, % meetin, num not mtg criteria

 . F J=1:1:$L(ADEAGES,";") D

 . . S ADEAGEG=$P(ADEAGES,";",J)

 . . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADEMED,ADEAGEG)

 . . S ADEMQ=$P(ADEM,U)

 . . S ADEMY=$P(ADEM,U,2)

 . . S ADEM3=$P(ADEM,U,3)

 . . S ADED=$$GETCNT^ADEKRP(ADEYQ,ADEDEN,ADEAGEG)

 . . S ADEDQ=$P(ADED,U)

 . . S ADEDY=$P(ADED,U,2)

 . . S ADED3=$P(ADED,U,3)

 . . S ADEA=$$GETCNT^ADEKRP(ADEYQ,ADEASD,ADEAGEG)

 . . S ADEAQ=$P(ADEA,U)

 . . S ADEAY=$P(ADEA,U,2)

 . . S ADEA3=$P(ADEA,U,3)

 . . S ADEC=$$GETCNT^ADEKRP(ADEYQ,"."_ADEIEN_".",ADEAGEG)

 . . S ADECQ=$P(ADEC,U)

 . . S ADECY=$P(ADEC,U,2)

 . . S ADEC3=$P(ADEC,U,3)

 . . I $P(ADEAGEG,":")=$P(ADEAGEG,":",2) S ADEAGEG=$P(ADEAGEG,":")

 . . E  S ADEAGEG=$P(ADEAGEG,":")_"."_$P(ADEAGEG,":",2)

 . . I ADEPER="SQ" S ^TMP("ADEP",ADEU,"SQ",ADEIEN,ADEAGEG)=ADEM3_U_ADED3_U_ADEDQ_U_ADEAQ_U_$S(ADEAQ:$J(ADECQ/ADEAQ*100,5,1),1:"-")_U_$S(ADEAQ:ADEAQ-ADECQ,1:"-")

 . . I ADEPER["A" S ^TMP("ADEP",ADEU,ADEPER,ADEIEN,ADEAGEG)=ADEM3_U_ADED3_U_ADEDY_U_ADEAY_U_$S(ADEAY:$J(ADECY/ADEAY*100,5,1),1:"-")_U_$S(ADEAY:ADEAY-ADECY,1:"-")

 . . I ADEPER="CQ" S ^TMP("ADEP",ADEU,"CQ",ADEIEN,ADEYQ,ADEAGEG)=ADEM3_U_ADED3_U_ADEDQ_U_ADEAQ_U_$S(ADEAQ:$J(ADECQ/ADEAQ*100,5,1),1:"-")_U_$S(ADEAQ:ADEAQ-ADECQ,1:"-")

 . . Q

 . Q

 Q

ADEKRP6   ; IHS/HQT/MJL - PRINT COMPILED REPORTS ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;

 +3       ;

 +4       ;Process from ^ADEKNT to create report array ADEREP(

 +5       ;ADEYQ=Year.Quarter ADEIEN=IEN in ^ADEKOB file

 +6       ;ADEREP(REPORT TYPE,ADEIEN)=OBJECTIVE NAME

 +7       ;ADEREP(SQ,ADEIEN,AGE)=3YU^D3YU^DVIS3MON^ASSESSD3MON^NUMBER

 +8       ;ADEREP(CQ,ADEIEN,ADEYQ,AGE)=3YU^D3YU^DVIS3MON^ASSESSD3MON^NUMBER

 +9       ;ADEREP(SA,ADEIEN,AGE)=3YU,D3YU,DVIS12MON^ASD12MON^NUM

 +10      ;ADEREP(CA,ADEIEN,AGE)=3YU,D3YU,DVIS12MON^ASD12MON^NUM

 +11      ;

SINGLE(ADEPER,ADEYQ) ;EP

 +1       ;ADEPER="SQ","CQ","SA" OR "CA"

 +2       ;for Single or Combined, Quarterly or Annual

 +3       ;

 +4       ;For each objective in REPORT ORDER xref of ^ADEKOB

 +5        NEW J,ADEORD,ADENOD,ADEIEN,ADEOBJN,ADEAGEG,ADEAGES,ADEM,ADEMQ,ADEMY,ADEM3,ADED,ADEDQ,ADEDY,ADED3,ADEA,ADEAQ,ADEAY,ADEA3,ADEC,ADECQ,ADECY,ADEC3

 +6        SET ADEORD=0

 +7        FOR 

               SET ADEORD=$ORDER(^ADEKOB("AC",ADEORD))

               IF '+ADEORD

                   QUIT 

               Begin DoDot:1

 +8                SET ADEIEN=$ORDER(^ADEKOB("AC",ADEORD,0))

 +9                SET ADENOD=^ADEKOB(ADEIEN,0)

 +10               SET ADEOBJN=$PIECE(ADENOD,U)

 +11               SET ^TMP("ADEP",ADEU,ADEPER,ADEIEN)=ADEOBJN

 +12               SET ADEAGES=$PIECE(ADENOD,U,$SELECT(ADEPER["S":3,1:2))

 +13               IF ADEAGES="EACH"

                       Begin DoDot:2

 +14                       NEW J

 +15                       SET ADEAGES=""

 +16                       FOR J=0:1:74

                               SET $PIECE(ADEAGES,";",J+1)=J_":"_J

 +17                       SET $PIECE(ADEAGES,";",76)="75:125"

                       End DoDot:2

 +18      ;For each age in CountAges (Single rpts) or MonitorAges (Combined)

 +19      ;Get 3yu, d3yu, d3monu, ass3mon, % meetin, num not mtg criteria

 +20               FOR J=1:1:$LENGTH(ADEAGES,";")

                       Begin DoDot:2

 +21                       SET ADEAGEG=$PIECE(ADEAGES,";",J)

 +22                       SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADEMED,ADEAGEG)

 +23                       SET ADEMQ=$PIECE(ADEM,U)

 +24                       SET ADEMY=$PIECE(ADEM,U,2)

 +25                       SET ADEM3=$PIECE(ADEM,U,3)

 +26                       SET ADED=$$GETCNT^ADEKRP(ADEYQ,ADEDEN,ADEAGEG)

 +27                       SET ADEDQ=$PIECE(ADED,U)

 +28                       SET ADEDY=$PIECE(ADED,U,2)

 +29                       SET ADED3=$PIECE(ADED,U,3)

 +30                       SET ADEA=$$GETCNT^ADEKRP(ADEYQ,ADEASD,ADEAGEG)

 +31                       SET ADEAQ=$PIECE(ADEA,U)

 +32                       SET ADEAY=$PIECE(ADEA,U,2)

 +33                       SET ADEA3=$PIECE(ADEA,U,3)

 +34                       SET ADEC=$$GETCNT^ADEKRP(ADEYQ,"."_ADEIEN_".",ADEAGEG)

 +35                       SET ADECQ=$PIECE(ADEC,U)

 +36                       SET ADECY=$PIECE(ADEC,U,2)

 +37                       SET ADEC3=$PIECE(ADEC,U,3)

 +38                       IF $PIECE(ADEAGEG,":")=$PIECE(ADEAGEG,":",2)

                               SET ADEAGEG=$PIECE(ADEAGEG,":")

 +39                      IF '$TEST

                               SET ADEAGEG=$PIECE(ADEAGEG,":")_"."_$PIECE(ADEAGEG,":",2)

 +40                       IF ADEPER="SQ"

                               SET ^TMP("ADEP",ADEU,"SQ",ADEIEN,ADEAGEG)=ADEM3_U_ADED3_U_ADEDQ_U_ADEAQ_U_$SELECT(ADEAQ:$JUSTIFY(ADECQ/ADEAQ*100,5,1),1:"-")_U_$SELECT(ADEAQ:ADEAQ-ADECQ,1:"-")

 +41                       IF ADEPER["A"

                               SET ^TMP("ADEP",ADEU,ADEPER,ADEIEN,ADEAGEG)=ADEM3_U_ADED3_U_ADEDY_U_ADEAY_U_$SELECT(ADEAY:$JUSTIFY(ADECY/ADEAY*100,5,1),1:"-")_U_$SELECT(ADEAY:ADEAY-ADECY,1:"-")

 +42                       IF ADEPER="CQ"

                               SET ^TMP("ADEP",ADEU,"CQ",ADEIEN,ADEYQ,ADEAGEG)=ADEM3_U_ADED3_U_ADEDQ_U_ADEAQ_U_$SELECT(ADEAQ:$JUSTIFY(ADECQ/ADEAQ*100,5,1),1:"-")_U_$SELECT(ADEAQ:ADEAQ-ADECQ,1:"-")

 +43                       QUIT 

                       End DoDot:2

 +44               QUIT 

               End DoDot:1

 +45       QUIT