- ADEPQA ; IHS/HQT/MJL - QA ENGINE ;11:07 AM [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;;APRIL 1999
- ;
- K ^ADEUTL("ADEPQA",$J),ADEEXT ;^ADEUTL is a transient working global
- N ADEHXO,ADEHXC,ADESTP,ADEDATE,ADEAGE,ADEPROV,ADEHYG,ADELOC,ADEJ,ADEROPT,ADETFIL,ADETNAM,ADETDFN,ADEADA,BY,FLDS,FR,TO,DIC,DHD,ZTSK
- CTRL D SEARCH G:$$HAT() END ;Set up Search parameters
- CTRL1 D OUTPUT^ADEPQA1B G:$$HAT() CTRL ;Select Output Format & template
- EN ;EP - Enter here with above predefined
- D ASKDEV^ADEPQA1B I POP K POP G END
- ;FHL 9/9/98 I $D(ZTSK) G END
- I $D(ZTQUEUED) G END
- ZTM ;EP -
- D ROLL ;$O through entries and screen accdng to criteria
- I '$D(^DIBT(ADETDFN,1)) G END ;W !,"NO MATCHES" G END ;Improve msg
- I '$D(ADEEXT) D PRINT ;Print Report
- ;
- END Q:$D(ADEEXT) ;ADEEXT means it's an external call which is
- ; doing its own device handling
- D ^%ZISC
- I $D(ZTQUEUED) D
- . D KILL^%ZTLOAD
- . I $D(ADETNAM),ADETNAM?1"ADEQA"1.5N D DELTMP(ADETDFN)
- I '$D(ZTQUEUED) D
- . ;FHL 9/9/98 I '$D(ZTSK),$D(ADETNAM),ADETNAM?1"ADEQA"1.5N D DELTMP(ADETDFN)
- . I '$D(ZTQUEUED),$D(ADETNAM),ADETNAM?1"ADEQA"1.5N D DELTMP(ADETDFN)
- Q
- ;
- PRINT ;
- N ADEDUZ,ADEY
- D EN1^DIP
- Q
- ;
- SEARCH ;
- W !!,?5,"***STEP ONE: Select SEARCH PARAMETERS***"
- S ADESTP=$$STP^ADEPQA3() Q:$$HAT()
- SRCH1 S ADEDATE=$$DATE^ADEPQA3() G:$$HAT() SEARCH
- SRCH2 S ADEAGE=$$AGE^ADEPQA3() G:$$HAT() SRCH1
- SRCH3 S ADEPROV=$$PROV^ADEPQA3() G:$$HAT() SRCH2
- SRCH4 S ADEHYG=$$HYG^ADEPQA3() G:$$HAT() SRCH3
- SRCH5 S ADELOC=$$LOC^ADEPQA3() G:$$HAT() SRCH4
- F ADEJ=1:1:1 S ADEADA(ADEJ)=$$ADA^ADEPQA3A()
- G:$$HAT() SRCH5
- I '$$CHK^ADEPQA4() G SEARCH ;Ask user to verify search params
- Q
- ;
- ROLL ;EP - At this point, all variables needed to do the report are defined
- ;This subrtn $O's through ADEPCD using the DATE xref (or the PRO
- ;VIDER xref if it's provider-limited but not date-limited)
- ;Hits are stored in the template.
- N ADEHXC,ADEHXO
- I +ADESTP,$P(ADESTP,U,3)="9002007" D Q
- . N ADEDFN,ADESTD
- . S ADESTD=$P(ADESTP,U,2)
- . S ADEDFN=0
- . F S ADEDFN=$O(^DIBT(ADESTD,1,ADEDFN)) Q:'+ADEDFN D SCREEN(ADEDFN)
- I +ADESTP,$P(ADESTP,U,3)="9000001" D Q
- . N ADEDFN,ADESTD,ADEBEG,ADEND,ADEPAT
- . S ADESTD=$P(ADESTP,U,2)
- . S ADEPAT=0
- . S ADEND=$P(ADEDATE,U,3)
- . F S ADEPAT=$O(^DIBT(ADESTD,1,ADEPAT)) Q:'+ADEPAT S ADEBEG=$P(ADEDATE,U,2)-1 D
- . . F S ADEBEG=$O(^ADEPCD("DATE",ADEPAT,ADEBEG)) Q:'+ADEBEG Q:ADEBEG>ADEND S ADEDFN=0 D
- . . . F S ADEDFN=$O(^ADEPCD("DATE",ADEPAT,ADEBEG,ADEDFN)) Q:'+ADEDFN D SCREEN(ADEDFN)
- ;
- I +ADEDATE,$P(ADEROPT,U,2)'["PATIENT" D Q
- . N ADEBEG,ADEND,ADEDFN
- . S ADEBEG=$P(ADEDATE,U,2)-1,ADEND=$P(ADEDATE,U,3)
- . F S ADEBEG=$O(^ADEPCD("AC",ADEBEG)) Q:ADEBEG>ADEND Q:'+ADEBEG S ADEDFN=0 D
- . . F S ADEDFN=$O(^ADEPCD("AC",ADEBEG,ADEDFN)) Q:'ADEDFN D SCREEN(ADEDFN)
- I +ADEDATE,$P(ADEROPT,U,2)["PATIENT" D Q
- . N ADEBEG,ADEND,ADEDFN,ADEPAT
- . S ADEPAT=0
- . S ADEND=$P(ADEDATE,U,3)
- . F S ADEPAT=$O(^ADEPCD("DATE",ADEPAT)) Q:'+ADEPAT S ADEBEG=$P(ADEDATE,U,2)-1 D
- . . F S ADEBEG=$O(^ADEPCD("DATE",ADEPAT,ADEBEG)) Q:ADEBEG>ADEND Q:'+ADEBEG S ADEDFN=0 D
- . . . F S ADEDFN=$O(^ADEPCD("DATE",ADEPAT,ADEBEG,ADEDFN)) Q:'+ADEDFN D SCREEN(ADEDFN)
- Q
- K ADESTD,ADETFIL,ADETNAM ;*NE
- ;------->SUB-SUBROUTINES
- SCREEN(ADEDFN) ;
- ;Applies screens to ADEPCD entry ADEDFN
- N ADENOD
- S ADENOD=^ADEPCD(ADEDFN,0)
- I +ADESTP,$P(ADESTP,U,3)="9002007",'$$DATSCN^ADEPQA1C(ADENOD) Q
- I +ADEAGE,'$$AGESCN^ADEPQA1C(ADENOD) Q
- I +ADELOC,'$$LOCSCN^ADEPQA1C(ADENOD) Q
- I +ADEPROV,'$$PRVSCN^ADEPQA1C(ADENOD) Q
- I +ADEHYG,'$$HYGSCN^ADEPQA1C(ADENOD) Q
- I +ADEADA(1),'$$CODSCN^ADEPQA1D(ADEDFN) Q
- D HIT(ADEDFN)
- Q
- HIT(ADEDFN) ;
- ;Adds ADEDFN to whatever template we're using
- I $P(ADEROPT,U,2)="DENTAL" S ^DIBT(ADETDFN,1,ADEDFN)=""
- E S ^DIBT(ADETDFN,1,$P(^ADEPCD(ADEDFN,0),U))=""
- Q
- ;------->FUNCTIONS
- HAT() ;EP
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q 1
- Q 0
- ;
- TMPLAT(ADETNAM,ADETFIL) ;EP
- ;Creates entry in SORT TEMPLATE file attached to file # ADETFIL
- ;Returns template DFN
- N DIC,X,DD,D0,Y,DR,DO
- S DIC="^DIBT(",X=ADETNAM,DIC(0)="LZ",DIC("DR")="4///"_ADETFIL_";5///"_DUZ K DD,DO D FILE^DICN
- Q +Y
- ;
- ;
- DELTMP(ADETDFN) ;EP - Deletes template ADETDFN
- N DR,DA,DIE
- S DA=ADETDFN
- S DR=".01///@",DIE="^DIBT("
- D ^DIE
- Q
- ADEPQA ; IHS/HQT/MJL - QA ENGINE ;11:07 AM [ 03/24/1999 9:04 AM ]
- +1 ;;6.0;ADE;;APRIL 1999
- +2 ;
- +3 ;^ADEUTL is a transient working global
- KILL ^ADEUTL("ADEPQA",$JOB),ADEEXT
- +4 NEW ADEHXO,ADEHXC,ADESTP,ADEDATE,ADEAGE,ADEPROV,ADEHYG,ADELOC,ADEJ,ADEROPT,ADETFIL,ADETNAM,ADETDFN,ADEADA,BY,FLDS,FR,TO,DIC,DHD,ZTSK
- CTRL ;Set up Search parameters
- DO SEARCH
- IF $$HAT()
- GOTO END
- CTRL1 ;Select Output Format & template
- DO OUTPUT^ADEPQA1B
- IF $$HAT()
- GOTO CTRL
- EN ;EP - Enter here with above predefined
- +1 DO ASKDEV^ADEPQA1B
- IF POP
- KILL POP
- GOTO END
- +2 ;FHL 9/9/98 I $D(ZTSK) G END
- +3 IF $DATA(ZTQUEUED)
- GOTO END
- ZTM ;EP -
- +1 ;$O through entries and screen accdng to criteria
- DO ROLL
- +2 ;W !,"NO MATCHES" G END ;Improve msg
- IF '$DATA(^DIBT(ADETDFN,1))
- GOTO END
- +3 ;Print Report
- IF '$DATA(ADEEXT)
- DO PRINT
- +4 ;
- END ;ADEEXT means it's an external call which is
- IF $DATA(ADEEXT)
- QUIT
- +1 ; doing its own device handling
- +2 DO ^%ZISC
- +3 IF $DATA(ZTQUEUED)
- Begin DoDot:1
- +4 DO KILL^%ZTLOAD
- +5 IF $DATA(ADETNAM)
- IF ADETNAM?1"ADEQA"1.5N
- DO DELTMP(ADETDFN)
- End DoDot:1
- +6 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +7 ;FHL 9/9/98 I '$D(ZTSK),$D(ADETNAM),ADETNAM?1"ADEQA"1.5N D DELTMP(ADETDFN)
- +8 IF '$DATA(ZTQUEUED)
- IF $DATA(ADETNAM)
- IF ADETNAM?1"ADEQA"1.5N
- DO DELTMP(ADETDFN)
- End DoDot:1
- +9 QUIT
- +10 ;
- PRINT ;
- +1 NEW ADEDUZ,ADEY
- +2 DO EN1^DIP
- +3 QUIT
- +4 ;
- SEARCH ;
- +1 WRITE !!,?5,"***STEP ONE: Select SEARCH PARAMETERS***"
- +2 SET ADESTP=$$STP^ADEPQA3()
- IF $$HAT()
- QUIT
- SRCH1 SET ADEDATE=$$DATE^ADEPQA3()
- IF $$HAT()
- GOTO SEARCH
- SRCH2 SET ADEAGE=$$AGE^ADEPQA3()
- IF $$HAT()
- GOTO SRCH1
- SRCH3 SET ADEPROV=$$PROV^ADEPQA3()
- IF $$HAT()
- GOTO SRCH2
- SRCH4 SET ADEHYG=$$HYG^ADEPQA3()
- IF $$HAT()
- GOTO SRCH3
- SRCH5 SET ADELOC=$$LOC^ADEPQA3()
- IF $$HAT()
- GOTO SRCH4
- +1 FOR ADEJ=1:1:1
- SET ADEADA(ADEJ)=$$ADA^ADEPQA3A()
- +2 IF $$HAT()
- GOTO SRCH5
- +3 ;Ask user to verify search params
- IF '$$CHK^ADEPQA4()
- GOTO SEARCH
- +4 QUIT
- +5 ;
- ROLL ;EP - At this point, all variables needed to do the report are defined
- +1 ;This subrtn $O's through ADEPCD using the DATE xref (or the PRO
- +2 ;VIDER xref if it's provider-limited but not date-limited)
- +3 ;Hits are stored in the template.
- +4 NEW ADEHXC,ADEHXO
- +5 IF +ADESTP
- IF $PIECE(ADESTP,U,3)="9002007"
- Begin DoDot:1
- +6 NEW ADEDFN,ADESTD
- +7 SET ADESTD=$PIECE(ADESTP,U,2)
- +8 SET ADEDFN=0
- +9 FOR
- SET ADEDFN=$ORDER(^DIBT(ADESTD,1,ADEDFN))
- IF '+ADEDFN
- QUIT
- DO SCREEN(ADEDFN)
- End DoDot:1
- QUIT
- +10 IF +ADESTP
- IF $PIECE(ADESTP,U,3)="9000001"
- Begin DoDot:1
- +11 NEW ADEDFN,ADESTD,ADEBEG,ADEND,ADEPAT
- +12 SET ADESTD=$PIECE(ADESTP,U,2)
- +13 SET ADEPAT=0
- +14 SET ADEND=$PIECE(ADEDATE,U,3)
- +15 FOR
- SET ADEPAT=$ORDER(^DIBT(ADESTD,1,ADEPAT))
- IF '+ADEPAT
- QUIT
- SET ADEBEG=$PIECE(ADEDATE,U,2)-1
- Begin DoDot:2
- +16 FOR
- SET ADEBEG=$ORDER(^ADEPCD("DATE",ADEPAT,ADEBEG))
- IF '+ADEBEG
- QUIT
- IF ADEBEG>ADEND
- QUIT
- SET ADEDFN=0
- Begin DoDot:3
- +17 FOR
- SET ADEDFN=$ORDER(^ADEPCD("DATE",ADEPAT,ADEBEG,ADEDFN))
- IF '+ADEDFN
- QUIT
- DO SCREEN(ADEDFN)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +18 ;
- +19 IF +ADEDATE
- IF $PIECE(ADEROPT,U,2)'["PATIENT"
- Begin DoDot:1
- +20 NEW ADEBEG,ADEND,ADEDFN
- +21 SET ADEBEG=$PIECE(ADEDATE,U,2)-1
- SET ADEND=$PIECE(ADEDATE,U,3)
- +22 FOR
- SET ADEBEG=$ORDER(^ADEPCD("AC",ADEBEG))
- IF ADEBEG>ADEND
- QUIT
- IF '+ADEBEG
- QUIT
- SET ADEDFN=0
- Begin DoDot:2
- +23 FOR
- SET ADEDFN=$ORDER(^ADEPCD("AC",ADEBEG,ADEDFN))
- IF 'ADEDFN
- QUIT
- DO SCREEN(ADEDFN)
- End DoDot:2
- End DoDot:1
- QUIT
- +24 IF +ADEDATE
- IF $PIECE(ADEROPT,U,2)["PATIENT"
- Begin DoDot:1
- +25 NEW ADEBEG,ADEND,ADEDFN,ADEPAT
- +26 SET ADEPAT=0
- +27 SET ADEND=$PIECE(ADEDATE,U,3)
- +28 FOR
- SET ADEPAT=$ORDER(^ADEPCD("DATE",ADEPAT))
- IF '+ADEPAT
- QUIT
- SET ADEBEG=$PIECE(ADEDATE,U,2)-1
- Begin DoDot:2
- +29 FOR
- SET ADEBEG=$ORDER(^ADEPCD("DATE",ADEPAT,ADEBEG))
- IF ADEBEG>ADEND
- QUIT
- IF '+ADEBEG
- QUIT
- SET ADEDFN=0
- Begin DoDot:3
- +30 FOR
- SET ADEDFN=$ORDER(^ADEPCD("DATE",ADEPAT,ADEBEG,ADEDFN))
- IF '+ADEDFN
- QUIT
- DO SCREEN(ADEDFN)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +31 QUIT
- +32 ;*NE
- KILL ADESTD,ADETFIL,ADETNAM
- +33 ;------->SUB-SUBROUTINES
- SCREEN(ADEDFN) ;
- +1 ;Applies screens to ADEPCD entry ADEDFN
- +2 NEW ADENOD
- +3 SET ADENOD=^ADEPCD(ADEDFN,0)
- +4 IF +ADESTP
- IF $PIECE(ADESTP,U,3)="9002007"
- IF '$$DATSCN^ADEPQA1C(ADENOD)
- QUIT
- +5 IF +ADEAGE
- IF '$$AGESCN^ADEPQA1C(ADENOD)
- QUIT
- +6 IF +ADELOC
- IF '$$LOCSCN^ADEPQA1C(ADENOD)
- QUIT
- +7 IF +ADEPROV
- IF '$$PRVSCN^ADEPQA1C(ADENOD)
- QUIT
- +8 IF +ADEHYG
- IF '$$HYGSCN^ADEPQA1C(ADENOD)
- QUIT
- +9 IF +ADEADA(1)
- IF '$$CODSCN^ADEPQA1D(ADEDFN)
- QUIT
- +10 DO HIT(ADEDFN)
- +11 QUIT
- HIT(ADEDFN) ;
- +1 ;Adds ADEDFN to whatever template we're using
- +2 IF $PIECE(ADEROPT,U,2)="DENTAL"
- SET ^DIBT(ADETDFN,1,ADEDFN)=""
- +3 IF '$TEST
- SET ^DIBT(ADETDFN,1,$PIECE(^ADEPCD(ADEDFN,0),U))=""
- +4 QUIT
- +5 ;------->FUNCTIONS
- HAT() ;EP
- +1 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
- QUIT 1
- +2 QUIT 0
- +3 ;
- TMPLAT(ADETNAM,ADETFIL) ;EP
- +1 ;Creates entry in SORT TEMPLATE file attached to file # ADETFIL
- +2 ;Returns template DFN
- +3 NEW DIC,X,DD,D0,Y,DR,DO
- +4 SET DIC="^DIBT("
- SET X=ADETNAM
- SET DIC(0)="LZ"
- SET DIC("DR")="4///"_ADETFIL_";5///"_DUZ
- KILL DD,DO
- DO FILE^DICN
- +5 QUIT +Y
- +6 ;
- +7 ;
- DELTMP(ADETDFN) ;EP - Deletes template ADETDFN
- +1 NEW DR,DA,DIE
- +2 SET DA=ADETDFN
- +3 SET DR=".01///@"
- SET DIE="^DIBT("
- +4 DO ^DIE
- +5 QUIT
