AQAOPC3.m

AQAOPC3 ; IHS/ORDC/LJF - OCC BY VISIT & PATIENT ;

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

 ;

 ;This rtn contains 2 entry points for printing occurrence lists

 ;1 - by patient and 2 - by visit.  These reports are included among 

 ;the trending reports.

 ;

BYVISIT ;ENTRY POINT for option to print occ by visit   

 D BYVISIT^AQAOHOP2 ;intro text

VPAT ; >>> ask user for patient name or chart #

 W !! K DIC S DIC="^DPT(",DIC(0)="AEMQZ" D ^DIC G EXIT:Y=-1

 S AQAOPAT=+Y

 ;

 W !!,"Select VISIT DATE linked to an occurrence you are evaluating."

VVISIT ; >>> ask user for patient visit

 W !! K DIR S DIR(0)="DO^::EX",DIR("?")="^D VHELP^AQAOHOCC"

 S DIR("A")="Enter VISIT DATE" D ^DIR

 G VPAT:Y=U,VPAT:Y="" I Y<0 W *7," ??" G VVISIT

 S APCDVLDT=Y ;visit date variable

 S APCDPAT=AQAOPAT,(APCDOVRR,APCDLOOK,APCDVSIT)=""

 D ^APCDVLK ;visit lookup requiring only date

 K APCDOVRR,APCDLOOK,APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDPAT,APCDTYPE

 G VPAT:X=U

 I APCDVSIT="" W *7,"  NO VISIT FOR THAT DATE.  TRY AGAIN." G VVISIT

 ;

CHECK ; >>> check if visit is linked to occ available to user

 I '$D(^AQAOC("AE",AQAOPAT,APCDVSIT)) D  G VVISIT

 .W *7,"  NO OCCURRENCES FOR VISIT!",!

 S Y=0

 F  S Y=$O(^AQAOC("AE",AQAOPAT,APCDVSIT,Y)) Q:Y=""  D OCCCHK^AQAOSEC Q:$D(AQAOCHK("OK"))

 I '$D(AQAOCHK("OK")) D  G VVISIT

 .W *7,"  YOU DO NOT HAVE ACCESS TO ANY OCCURRENCES FOR THIS VISIT DATE",!

 ;

VPRINT ; >>> set variables and call dip     

 W !! S L=0,DIC="^AQAOC(",FLDS="[AQAO OCC LISTING]",BY="VISIT"

 ;screen for deleted occ and for selected patient

 S DIS(0)="I $P(^AQAOC(D0,1),U)'=2,$P(^(0),U,2)=AQAOPAT",AQAOINAC=""

 S (TO,FR)=$P(^AUPNVSIT(APCDVSIT,0),U) D EN1^DIP K APCDVSIT

 ;

 ;

EXIT ; >>> eoj

 D PRTOPT^AQAOVAR D KILL^AQAOUTIL Q

 ;

 ;

BYPAT ;ENTRY POINT for option to print occ by pat for visit range

 D BYPAT^AQAOHOP2 ;intro text

PPAT ; >>> ask user for patient name or chart #

 W !! K DIC S DIC="^DPT(",DIC(0)="AEMQZ" D ^DIC G EXIT:Y=-1

 S AQAOPAT=+Y

 ;

DATES ; >> ask user to choose date range

 S AQAOBD=$$BDATE^AQAOLKP G EXIT:AQAOBD=U,PPAT:AQAOBD=""

 S AQAOED=$$EDATE^AQAOLKP G EXIT:AQAOED=U,DATES:AQAOED=""

 ;

 ;

PPRINT ; >>> set variables and call dip     

 W !! S L=0,DIC="^AQAOC(",FLDS="[AQAO OCC LISTING]"

 S BY="@OCCURRENCE DATE",AQAOINAC=""

 ;screen for deleted occ and for selected patient

 S DIS(0)="I $P(^AQAOC(D0,1),U)'=2,$P(^(0),U,2)=AQAOPAT"

 S FR=AQAOBD,TO=AQAOED_".2400"

 D EN1^DIP

 G EXIT

AQAOPC3   ; IHS/ORDC/LJF - OCC BY VISIT & PATIENT ;

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

 +2       ;

 +3       ;This rtn contains 2 entry points for printing occurrence lists

 +4       ;1 - by patient and 2 - by visit.  These reports are included among 

 +5       ;the trending reports.

 +6       ;

BYVISIT   ;ENTRY POINT for option to print occ by visit   

 +1       ;intro text

           DO BYVISIT^AQAOHOP2

VPAT      ; >>> ask user for patient name or chart #

 +1        WRITE !!

           KILL DIC

           SET DIC="^DPT("

           SET DIC(0)="AEMQZ"

           DO ^DIC

           IF Y=-1

               GOTO EXIT

 +2        SET AQAOPAT=+Y

 +3       ;

 +4        WRITE !!,"Select VISIT DATE linked to an occurrence you are evaluating."

VVISIT    ; >>> ask user for patient visit

 +1        WRITE !!

           KILL DIR

           SET DIR(0)="DO^::EX"

           SET DIR("?")="^D VHELP^AQAOHOCC"

 +2        SET DIR("A")="Enter VISIT DATE"

           DO ^DIR

 +3        IF Y=U

               GOTO VPAT

           IF Y=""

               GOTO VPAT

           IF Y<0

               WRITE *7," ??"

               GOTO VVISIT

 +4       ;visit date variable

           SET APCDVLDT=Y

 +5        SET APCDPAT=AQAOPAT

           SET (APCDOVRR,APCDLOOK,APCDVSIT)=""

 +6       ;visit lookup requiring only date

           DO ^APCDVLK

 +7        KILL APCDOVRR,APCDLOOK,APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDPAT,APCDTYPE

 +8        IF X=U

               GOTO VPAT

 +9        IF APCDVSIT=""

               WRITE *7,"  NO VISIT FOR THAT DATE.  TRY AGAIN."

               GOTO VVISIT

 +10      ;

CHECK     ; >>> check if visit is linked to occ available to user

 +1        IF '$DATA(^AQAOC("AE",AQAOPAT,APCDVSIT))

               Begin DoDot:1

 +2                WRITE *7,"  NO OCCURRENCES FOR VISIT!",!

               End DoDot:1

               GOTO VVISIT

 +3        SET Y=0

 +4        FOR 

               SET Y=$ORDER(^AQAOC("AE",AQAOPAT,APCDVSIT,Y))

               IF Y=""

                   QUIT 

               DO OCCCHK^AQAOSEC

               IF $DATA(AQAOCHK("OK"))

                   QUIT 

 +5        IF '$DATA(AQAOCHK("OK"))

               Begin DoDot:1

 +6                WRITE *7,"  YOU DO NOT HAVE ACCESS TO ANY OCCURRENCES FOR THIS VISIT DATE",!

               End DoDot:1

               GOTO VVISIT

 +7       ;

VPRINT    ; >>> set variables and call dip     

 +1        WRITE !!

           SET L=0

           SET DIC="^AQAOC("

           SET FLDS="[AQAO OCC LISTING]"

           SET BY="VISIT"

 +2       ;screen for deleted occ and for selected patient

 +3        SET DIS(0)="I $P(^AQAOC(D0,1),U)'=2,$P(^(0),U,2)=AQAOPAT"

           SET AQAOINAC=""

 +4        SET (TO,FR)=$PIECE(^AUPNVSIT(APCDVSIT,0),U)

           DO EN1^DIP

           KILL APCDVSIT

 +5       ;

 +6       ;

EXIT      ; >>> eoj

 +1        DO PRTOPT^AQAOVAR

           DO KILL^AQAOUTIL

           QUIT 

 +2       ;

 +3       ;

BYPAT     ;ENTRY POINT for option to print occ by pat for visit range

 +1       ;intro text

           DO BYPAT^AQAOHOP2

PPAT      ; >>> ask user for patient name or chart #

 +1        WRITE !!

           KILL DIC

           SET DIC="^DPT("

           SET DIC(0)="AEMQZ"

           DO ^DIC

           IF Y=-1

               GOTO EXIT

 +2        SET AQAOPAT=+Y

 +3       ;

DATES     ; >> ask user to choose date range

 +1        SET AQAOBD=$$BDATE^AQAOLKP

           IF AQAOBD=U

               GOTO EXIT

           IF AQAOBD=""

               GOTO PPAT

 +2        SET AQAOED=$$EDATE^AQAOLKP

           IF AQAOED=U

               GOTO EXIT

           IF AQAOED=""

               GOTO DATES

 +3       ;

 +4       ;

PPRINT    ; >>> set variables and call dip     

 +1        WRITE !!

           SET L=0

           SET DIC="^AQAOC("

           SET FLDS="[AQAO OCC LISTING]"

 +2        SET BY="@OCCURRENCE DATE"

           SET AQAOINAC=""

 +3       ;screen for deleted occ and for selected patient

 +4        SET DIS(0)="I $P(^AQAOC(D0,1),U)'=2,$P(^(0),U,2)=AQAOPAT"

 +5        SET FR=AQAOBD

           SET TO=AQAOED_".2400"

 +6        DO EN1^DIP

 +7        GOTO EXIT