- 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
