AQAOPCX.m

AQAOPCX ; IHS/ORDC/LJF - EXTRA SCREENS ON REPORTS ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

 ;This is an extrinsic function called by trending reports to screen

 ;occurrences by the extra sorts that can be added to the reports.

 ;Called by ^AQAOPC11,^AQAOPC21,^AQAOPC41.

 ;Call based on existence of variable AQAOXS.

 ;

CHK(AQAOL)  ;ENTRY POINT EXTR FUNCTION to screen occ by user selected items

 ;variable AQAOL=ifn in QI SORT file

 ;

 N AQAOFLG,X,Y,Z,AQAONOD,I,AQAOX,AQAOY,AQAOICD0

 S AQAOFLG=0 K AQAOARS

 D MAINCHK ;check entries against screen

 I $D(AQAOARS) S AQAOFLG=1

 Q AQAOFLG ;1=keep occ, 0=bypass occ

 ;

 ;

MAINCHK ; >> SUBRTN to screen by items selected by user

 ; find data within occurrence for sort requested

 S X=$G(^AQAO1(9,AQAOL,"IFN")) Q:X=""  X X Q:AQAONOD=""  ;sets AQAONOD

 S AQAOX=0 F  S AQAOX=$O(@AQAONOD) Q:AQAOX=""  D

 .S (AQAOFL,DIC)=$P(^AQAO1(9,AQAOL,0),U,6),(AQAOFD,DR)=$P(^(0),U,7)

 .S DA=AQAOX,DIQ(0)="IE" K ^UTILITY("DIQ1",$J) D EN^DIQ1

 .S AQAOY=^UTILITY("DIQ1",$J,AQAOFL,AQAOX,AQAOFD,"I") Q:AQAOY=""

 .S AQAOY1=^UTILITY("DIQ1",$J,AQAOFL,AQAOX,AQAOFD,"E")

 .;

 .; first check: all values selected OR matches one user selected

 .I $D(AQAOXS(0))!($D(AQAOXS(1,+AQAOY))) S AQAOFLG=1 D XTRACHK

 .;

 .I AQAOFLG=1 D  ;if passed both checks, set printable value

 ..I '$D(AQAOXS(0)),'$D(AQAOXS(1,+AQAOY)) Q

 ..I AQAOXSM="PROV"  S AQAOARS($$CLASS_$$TYPE_+AQAOY)="" Q

 ..S AQAOARS(AQAOY1)=""

 K ^UTILITY("DIQ1",$J) Q

 ;

 ;

XTRACHK ; >> SUBRTN to check xtra screen requested by user

 S I=1

 F  S I=$O(AQAOXS(I)) Q:I=""  Q:AQAOFLG=0  D

 .S Y=$G(^AQAO1(9,AQAOL,"SCREEN")) X Y

 .I Z="" S AQAOFLG=0 Q

 .I Z'[AQAOXS(I) S AQAOFLG=0

 Q

 ;

CLASS() ; -- EXTRN VAR to return provider class if any

 I AQAOY'["VA(200" Q ""

 S X=$$VAL^XBDIQ1(200,+AQAOY,53.5)

 Q $S(X="":"",1:X_": ")

 ;

TYPE() ; -- EXTRN VAR to return provider, person, or vendor

 Q $S(AQAOY["AUTTVNDR":"VENDOR",$$CLASS="":"PERSON",1:"PROVIDER")_" #"

AQAOPCX   ; IHS/ORDC/LJF - EXTRA SCREENS ON REPORTS ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;

 +3       ;This is an extrinsic function called by trending reports to screen

 +4       ;occurrences by the extra sorts that can be added to the reports.

 +5       ;Called by ^AQAOPC11,^AQAOPC21,^AQAOPC41.

 +6       ;Call based on existence of variable AQAOXS.

 +7       ;

CHK(AQAOL) ;ENTRY POINT EXTR FUNCTION to screen occ by user selected items

 +1       ;variable AQAOL=ifn in QI SORT file

 +2       ;

 +3        NEW AQAOFLG,X,Y,Z,AQAONOD,I,AQAOX,AQAOY,AQAOICD0

 +4        SET AQAOFLG=0

           KILL AQAOARS

 +5       ;check entries against screen

           DO MAINCHK

 +6        IF $DATA(AQAOARS)

               SET AQAOFLG=1

 +7       ;1=keep occ, 0=bypass occ

           QUIT AQAOFLG

 +8       ;

 +9       ;

MAINCHK   ; >> SUBRTN to screen by items selected by user

 +1       ; find data within occurrence for sort requested

 +2       ;sets AQAONOD

           SET X=$GET(^AQAO1(9,AQAOL,"IFN"))

           IF X=""

               QUIT 

           XECUTE X

           IF AQAONOD=""

               QUIT 

 +3        SET AQAOX=0

           FOR 

               SET AQAOX=$ORDER(@AQAONOD)

               IF AQAOX=""

                   QUIT 

               Begin DoDot:1

 +4                SET (AQAOFL,DIC)=$PIECE(^AQAO1(9,AQAOL,0),U,6)

                   SET (AQAOFD,DR)=$PIECE(^(0),U,7)

 +5                SET DA=AQAOX

                   SET DIQ(0)="IE"

                   KILL ^UTILITY("DIQ1",$JOB)

                   DO EN^DIQ1

 +6                SET AQAOY=^UTILITY("DIQ1",$JOB,AQAOFL,AQAOX,AQAOFD,"I")

                   IF AQAOY=""

                       QUIT 

 +7                SET AQAOY1=^UTILITY("DIQ1",$JOB,AQAOFL,AQAOX,AQAOFD,"E")

 +8       ;

 +9       ; first check: all values selected OR matches one user selected

 +10               IF $DATA(AQAOXS(0))!($DATA(AQAOXS(1,+AQAOY)))

                       SET AQAOFLG=1

                       DO XTRACHK

 +11      ;

 +12      ;if passed both checks, set printable value

                   IF AQAOFLG=1

                       Begin DoDot:2

 +13                       IF '$DATA(AQAOXS(0))

                               IF '$DATA(AQAOXS(1,+AQAOY))

                                   QUIT 

 +14                       IF AQAOXSM="PROV"

                               SET AQAOARS($$CLASS_$$TYPE_+AQAOY)=""

                               QUIT 

 +15                       SET AQAOARS(AQAOY1)=""

                       End DoDot:2

               End DoDot:1

 +16       KILL ^UTILITY("DIQ1",$JOB)

           QUIT 

 +17      ;

 +18      ;

XTRACHK   ; >> SUBRTN to check xtra screen requested by user

 +1        SET I=1

 +2        FOR 

               SET I=$ORDER(AQAOXS(I))

               IF I=""

                   QUIT 

               IF AQAOFLG=0

                   QUIT 

               Begin DoDot:1

 +3                SET Y=$GET(^AQAO1(9,AQAOL,"SCREEN"))

                   XECUTE Y

 +4                IF Z=""

                       SET AQAOFLG=0

                       QUIT 

 +5                IF Z'[AQAOXS(I)

                       SET AQAOFLG=0

               End DoDot:1

 +6        QUIT 

 +7       ;

CLASS()   ; -- EXTRN VAR to return provider class if any

 +1        IF AQAOY'["VA(200"

               QUIT ""

 +2        SET X=$$VAL^XBDIQ1(200,+AQAOY,53.5)

 +3        QUIT $SELECT(X="":"",1:X_": ")

 +4       ;

TYPE()    ; -- EXTRN VAR to return provider, person, or vendor

 +1        QUIT $SELECT(AQAOY["AUTTVNDR":"VENDOR",$$CLASS="":"PERSON",1:"PROVIDER")_" #"