AQAOEDTP ; IHS/ORDC/LJF - SPECIAL SUBRTNS FOR DATA ENTRY ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn is called by ^AQAOEDTS to display PCC data for visit.
;If there is PCC data, it then calls ^AQAOEDTA to stuff data into
;QI OCC files.
;
DX ;EP to display any PCC DX data for visit
;called by ^AQAOEDTS via indirection
;from PRE-DISPLAY CODE field in QI DATA ENTRY file
S AQAOVSIT=$P($G(^AQAOC(AQAOIFN,0)),U,3) Q:AQAOVSIT="" ;no visit
;
I '$O(^AUPNVPOV("AD",AQAOVSIT,0)) W !?5,"No PCC data recorded for visit yet",! Q
W !?5,"**Choose only RELEVANT Diagnoses for this Occurrence**"
W !!?2,"DX Data in PCC: "
S (AQAODX,AQAOCNT)=0 K AQAOA ;find all v povs for visit
F S AQAODX=$O(^AUPNVPOV("AD",AQAOVSIT,AQAODX)) Q:AQAODX="" D
.Q:'$D(^AUPNVPOV(AQAODX,0)) S AQAODXS=^(0)
.S AQAOCNT=AQAOCNT+1 W ?19,AQAOCNT,")"
.S AQAODX1=$P(AQAODXS,U),AQAODX4=$P(AQAODXS,U,4) ;get pointers
.W ?23,$P(^ICD9(AQAODX1,0),U),?33,$E($P(^AUTNPOV(AQAODX4,0),U),1,40),!
.S AQAOA(AQAOCNT)=AQAODX1 ;set array with icd9 pointer
;
D CHOOSE^AQAOEDTA:'$O(@AQAOXY) ;if none in for occ,ask to add pcc dx
Q
;
;
PROC ;EP;to display any PCC procedure data for visit
;called by ^AQAOEDTS via indirection
;from PRE-DISPLAY CODE field in QI DATA ENTRY file
S AQAOVSIT=$P($G(^AQAOC(AQAOIFN,0)),U,3) Q:AQAOVSIT="" ;no visit
;
I '$O(^AUPNVPRC("AD",AQAOVSIT,0)) W !?5,"No PCC data recorded for visit yet",! Q
W !?5,"**Choose only RELEVANT Procedures for this Occurrence**"
W !!?2,"PCC Data for Visit: "
S (AQAODX,AQAOCNT)=0 K AQAOA ;find all procedures for visit
F S AQAODX=$O(^AUPNVPRC("AD",AQAOVSIT,AQAODX)) Q:AQAODX="" D
.Q:'$D(^AUPNVPRC(AQAODX,0)) S AQAODXS=^(0)
.S AQAOCNT=AQAOCNT+1 W ?22,AQAOCNT,")"
.S AQAODX1=$P(AQAODXS,U),AQAODX4=$P(AQAODXS,U,4)
.S AQAODX6=$P(AQAODXS,U,6) ;procedure date
.W ?26,$P(^ICD0(AQAODX1,0),U),?35,$E(AQAODX6,4,5)_"/"_$E(AQAODX6,6,7)
.W ?42,$E($P(^AUTNPOV(AQAODX4,0),U),1,37),!
.S AQAOA(AQAOCNT)=AQAODX1 ;set array with icd0 pointer
;
D CHOOSE^AQAOEDTA:'$O(@AQAOXY) ;if none in for occ,ask to add pcc proc
Q
;
DRUG ;EP; to display any PCC medication data for visit
;called by ^AQAOEDTS via indirection
;from PRE-DISPLAY CODE field in QI DATA ENTRY file
S AQAOVSIT=$P($G(^AQAOC(AQAOIFN,0)),U,3) Q:AQAOVSIT="" ;no visit
;
I '$O(^AUPNVMED("AD",AQAOVSIT,0)) W !?5,"No PCC data recorded for visit yet",! Q
W !?5,"**Choose only RELEVANT Medications for this Occurrence**"
W !!?2,"Medication Data in PCC: "
S (AQAODX,AQAOCNT)=0 K AQAOA ;find all medications for visit
F S AQAODX=$O(^AUPNVMED("AD",AQAOVSIT,AQAODX)) Q:AQAODX="" D
.Q:'$D(^AUPNVMED(AQAODX,0)) S AQAODXS=^(0)
.S AQAOCNT=AQAOCNT+1 W ?5,AQAOCNT,")"
.S AQAODX1=$P(AQAODXS,U),AQAODX5=$P(AQAODXS,U,5) ;drug & sig
.S AQAODX6=$P(AQAODXS,U,6),AQAODX9=$P(AQAODXS,U,9) ;quant & prov
.W ?10,$E($P(^PSDRUG(AQAODX1,0),U),1,15)
.W ?30,$E(AQAODX5,1,25)," ",AQAODX6
.S AQAODX9=$S($P(^DD(9000010.06,.01,0),U,3)="DIC(6,":^DIC(16,AQAODX9,"A3"),1:AQAODX9)
.W ?62,$E($P(^VA(200,AQAODX9,0),U),1,20),!
.S AQAOA(AQAOCNT)=AQAODX1 ;set array with psdrug pointer
;
D CHOOSE^AQAOEDTA:'$O(@AQAOXY) ;if none in for occ,ask to add pcc proc
Q
;
PROV ;EP; to display any PCC provider data for visit
;called by ^AQAOEDTS via indirection
;from PRE-DISPLAY CODE field in QI DATA ENTRY file
S AQAOVSIT=$P($G(^AQAOC(AQAOIFN,0)),U,3) Q:AQAOVSIT="" ;no visit
;
I '$O(^AUPNVPRV("AD",AQAOVSIT,0)),'$O(^AUPNVCHS("AD",AQAOVSIT,0)) W !?5,"No PCC data recorded for visit yet",! Q ;ENH1
W !?5,"**Choose only Providers RELATED to this Occurrence**"
W !!?2,"PCC Data for Visit: "
S (AQAODX,AQAOCNT)=0 K AQAOA ;find all providers for visit
F S AQAODX=$O(^AUPNVPRV("AD",AQAOVSIT,AQAODX)) Q:AQAODX="" D
.Q:'$D(^AUPNVPRV(AQAODX,0)) S AQAODXS=^(0)
.S AQAOCNT=AQAOCNT+1 W ?23,AQAOCNT,")"
.S AQAODX1=$P(AQAODXS,U),AQAODX4=$P(AQAODXS,U,4) ;get pointers
.S (AQAODX1,AQAOA(AQAOCNT))=$S($P(^DD(9000010.06,.01,0),U,3)="DIC(6,":^DIC(16,AQAODX1,"A3"),1:AQAODX1)
.W ?28,$E($P(^VA(200,AQAODX1,0),U),1,15),?45,$P(AQAODXS,U,4) ;name,p/s
.W ?50,$P(AQAODXS,U,5) ;operating/attending
.; ;provider class
.S X=$P($G(^VA(200,AQAODX1,"PS")),U,5)
.W:X]"" ?55,$E($P(^DIC(7,X,0),U),1,20)
.W ! S AQAOA(AQAOCNT)=AQAODX1_";VA(200,"
D PROV^AQAOEDTV
;
D CHOOSE^AQAOEDTA:'$O(@AQAOXY) ;if none in for occ,ask for pcc prov
Q
;
;
CRIT ;ENTRY POINT for code to stuff criteria linked file
;from PRE-DISPLAY CODE field in QI DATA ENTRY file
I '$D(^AQAO1(6,"C",AQAOIND)) W !!,"* NO CRITERIA DEFINED FOR THIS INDICATOR",! S AQAOQUIT=1 Q
S AQAOCRIT=0
F S AQAOCRIT=$O(^AQAO1(6,"C",AQAOIND,AQAOCRIT)) Q:AQAOCRIT="" D
.S X=$O(^AQAO1(6,"C",AQAOIND,AQAOCRIT,0)) Q:X=""
.Q:'$D(^AQAO1(6,AQAOCRIT,"IND",X)) ;bad xref
.Q:$D(^AQAOCC(5,"AC",AQAOIFN,AQAOCRIT)) ;criteria already in for occ
.K DIC,DR,DD,DO,DINUM S DIC(0)="L",DIC=AQAOGBL,DLAYGO=AQAOFL
.S DIC("DR")=".02////"_AQAOIFN_";.03////"_AQAOPAT
.S X=AQAOCRIT D FILE^DICN Q:Y=-1
.K DIE,DA,DR S DIE=AQAOGBL,DA=+Y
.S DR=AQAOFLD_" FIRST]"
.D ^DIE
Q
AQAOEDTP ; IHS/ORDC/LJF - SPECIAL SUBRTNS FOR DATA ENTRY ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn is called by ^AQAOEDTS to display PCC data for visit.
+4 ;If there is PCC data, it then calls ^AQAOEDTA to stuff data into
+5 ;QI OCC files.
+6 ;
DX ;EP to display any PCC DX data for visit
+1 ;called by ^AQAOEDTS via indirection
+2 ;from PRE-DISPLAY CODE field in QI DATA ENTRY file
+3 ;no visit
SET AQAOVSIT=$PIECE($GET(^AQAOC(AQAOIFN,0)),U,3)
IF AQAOVSIT=""
QUIT
+4 ;
+5 IF '$ORDER(^AUPNVPOV("AD",AQAOVSIT,0))
WRITE !?5,"No PCC data recorded for visit yet",!
QUIT
+6 WRITE !?5,"**Choose only RELEVANT Diagnoses for this Occurrence**"
+7 WRITE !!?2,"DX Data in PCC: "
+8 ;find all v povs for visit
SET (AQAODX,AQAOCNT)=0
KILL AQAOA
+9 FOR
SET AQAODX=$ORDER(^AUPNVPOV("AD",AQAOVSIT,AQAODX))
IF AQAODX=""
QUIT
Begin DoDot:1
+10 IF '$DATA(^AUPNVPOV(AQAODX,0))
QUIT
SET AQAODXS=^(0)
+11 SET AQAOCNT=AQAOCNT+1
WRITE ?19,AQAOCNT,")"
+12 ;get pointers
SET AQAODX1=$PIECE(AQAODXS,U)
SET AQAODX4=$PIECE(AQAODXS,U,4)
+13 WRITE ?23,$PIECE(^ICD9(AQAODX1,0),U),?33,$EXTRACT($PIECE(^AUTNPOV(AQAODX4,0),U),1,40),!
+14 ;set array with icd9 pointer
SET AQAOA(AQAOCNT)=AQAODX1
End DoDot:1
+15 ;
+16 ;if none in for occ,ask to add pcc dx
IF '$ORDER(@AQAOXY)
DO CHOOSE^AQAOEDTA
+17 QUIT
+18 ;
+19 ;
PROC ;EP;to display any PCC procedure data for visit
+1 ;called by ^AQAOEDTS via indirection
+2 ;from PRE-DISPLAY CODE field in QI DATA ENTRY file
+3 ;no visit
SET AQAOVSIT=$PIECE($GET(^AQAOC(AQAOIFN,0)),U,3)
IF AQAOVSIT=""
QUIT
+4 ;
+5 IF '$ORDER(^AUPNVPRC("AD",AQAOVSIT,0))
WRITE !?5,"No PCC data recorded for visit yet",!
QUIT
+6 WRITE !?5,"**Choose only RELEVANT Procedures for this Occurrence**"
+7 WRITE !!?2,"PCC Data for Visit: "
+8 ;find all procedures for visit
SET (AQAODX,AQAOCNT)=0
KILL AQAOA
+9 FOR
SET AQAODX=$ORDER(^AUPNVPRC("AD",AQAOVSIT,AQAODX))
IF AQAODX=""
QUIT
Begin DoDot:1
+10 IF '$DATA(^AUPNVPRC(AQAODX,0))
QUIT
SET AQAODXS=^(0)
+11 SET AQAOCNT=AQAOCNT+1
WRITE ?22,AQAOCNT,")"
+12 SET AQAODX1=$PIECE(AQAODXS,U)
SET AQAODX4=$PIECE(AQAODXS,U,4)
+13 ;procedure date
SET AQAODX6=$PIECE(AQAODXS,U,6)
+14 WRITE ?26,$PIECE(^ICD0(AQAODX1,0),U),?35,$EXTRACT(AQAODX6,4,5)_"/"_$EXTRACT(AQAODX6,6,7)
+15 WRITE ?42,$EXTRACT($PIECE(^AUTNPOV(AQAODX4,0),U),1,37),!
+16 ;set array with icd0 pointer
SET AQAOA(AQAOCNT)=AQAODX1
End DoDot:1
+17 ;
+18 ;if none in for occ,ask to add pcc proc
IF '$ORDER(@AQAOXY)
DO CHOOSE^AQAOEDTA
+19 QUIT
+20 ;
DRUG ;EP; to display any PCC medication data for visit
+1 ;called by ^AQAOEDTS via indirection
+2 ;from PRE-DISPLAY CODE field in QI DATA ENTRY file
+3 ;no visit
SET AQAOVSIT=$PIECE($GET(^AQAOC(AQAOIFN,0)),U,3)
IF AQAOVSIT=""
QUIT
+4 ;
+5 IF '$ORDER(^AUPNVMED("AD",AQAOVSIT,0))
WRITE !?5,"No PCC data recorded for visit yet",!
QUIT
+6 WRITE !?5,"**Choose only RELEVANT Medications for this Occurrence**"
+7 WRITE !!?2,"Medication Data in PCC: "
+8 ;find all medications for visit
SET (AQAODX,AQAOCNT)=0
KILL AQAOA
+9 FOR
SET AQAODX=$ORDER(^AUPNVMED("AD",AQAOVSIT,AQAODX))
IF AQAODX=""
QUIT
Begin DoDot:1
+10 IF '$DATA(^AUPNVMED(AQAODX,0))
QUIT
SET AQAODXS=^(0)
+11 SET AQAOCNT=AQAOCNT+1
WRITE ?5,AQAOCNT,")"
+12 ;drug & sig
SET AQAODX1=$PIECE(AQAODXS,U)
SET AQAODX5=$PIECE(AQAODXS,U,5)
+13 ;quant & prov
SET AQAODX6=$PIECE(AQAODXS,U,6)
SET AQAODX9=$PIECE(AQAODXS,U,9)
+14 WRITE ?10,$EXTRACT($PIECE(^PSDRUG(AQAODX1,0),U),1,15)
+15 WRITE ?30,$EXTRACT(AQAODX5,1,25)," ",AQAODX6
+16 SET AQAODX9=$SELECT($PIECE(^DD(9000010.06,.01,0),U,3)="DIC(6,":^DIC(16,AQAODX9,"A3"),1:AQAODX9)
+17 WRITE ?62,$EXTRACT($PIECE(^VA(200,AQAODX9,0),U),1,20),!
+18 ;set array with psdrug pointer
SET AQAOA(AQAOCNT)=AQAODX1
End DoDot:1
+19 ;
+20 ;if none in for occ,ask to add pcc proc
IF '$ORDER(@AQAOXY)
DO CHOOSE^AQAOEDTA
+21 QUIT
+22 ;
PROV ;EP; to display any PCC provider data for visit
+1 ;called by ^AQAOEDTS via indirection
+2 ;from PRE-DISPLAY CODE field in QI DATA ENTRY file
+3 ;no visit
SET AQAOVSIT=$PIECE($GET(^AQAOC(AQAOIFN,0)),U,3)
IF AQAOVSIT=""
QUIT
+4 ;
+5 ;ENH1
IF '$ORDER(^AUPNVPRV("AD",AQAOVSIT,0))
IF '$ORDER(^AUPNVCHS("AD",AQAOVSIT,0))
WRITE !?5,"No PCC data recorded for visit yet",!
QUIT
+6 WRITE !?5,"**Choose only Providers RELATED to this Occurrence**"
+7 WRITE !!?2,"PCC Data for Visit: "
+8 ;find all providers for visit
SET (AQAODX,AQAOCNT)=0
KILL AQAOA
+9 FOR
SET AQAODX=$ORDER(^AUPNVPRV("AD",AQAOVSIT,AQAODX))
IF AQAODX=""
QUIT
Begin DoDot:1
+10 IF '$DATA(^AUPNVPRV(AQAODX,0))
QUIT
SET AQAODXS=^(0)
+11 SET AQAOCNT=AQAOCNT+1
WRITE ?23,AQAOCNT,")"
+12 ;get pointers
SET AQAODX1=$PIECE(AQAODXS,U)
SET AQAODX4=$PIECE(AQAODXS,U,4)
+13 SET (AQAODX1,AQAOA(AQAOCNT))=$SELECT($PIECE(^DD(9000010.06,.01,0),U,3)="DIC(6,":^DIC(16,AQAODX1,"A3"),1:AQAODX1)
+14 ;name,p/s
WRITE ?28,$EXTRACT($PIECE(^VA(200,AQAODX1,0),U),1,15),?45,$PIECE(AQAODXS,U,4)
+15 ;operating/attending
WRITE ?50,$PIECE(AQAODXS,U,5)
+16 ; ;provider class
+17 SET X=$PIECE($GET(^VA(200,AQAODX1,"PS")),U,5)
+18 IF X]""
WRITE ?55,$EXTRACT($PIECE(^DIC(7,X,0),U),1,20)
+19 WRITE !
SET AQAOA(AQAOCNT)=AQAODX1_";VA(200,"
End DoDot:1
+20 DO PROV^AQAOEDTV
+21 ;
+22 ;if none in for occ,ask for pcc prov
IF '$ORDER(@AQAOXY)
DO CHOOSE^AQAOEDTA
+23 QUIT
+24 ;
+25 ;
CRIT ;ENTRY POINT for code to stuff criteria linked file
+1 ;from PRE-DISPLAY CODE field in QI DATA ENTRY file
+2 IF '$DATA(^AQAO1(6,"C",AQAOIND))
WRITE !!,"* NO CRITERIA DEFINED FOR THIS INDICATOR",!
SET AQAOQUIT=1
QUIT
+3 SET AQAOCRIT=0
+4 FOR
SET AQAOCRIT=$ORDER(^AQAO1(6,"C",AQAOIND,AQAOCRIT))
IF AQAOCRIT=""
QUIT
Begin DoDot:1
+5 SET X=$ORDER(^AQAO1(6,"C",AQAOIND,AQAOCRIT,0))
IF X=""
QUIT
+6 ;bad xref
IF '$DATA(^AQAO1(6,AQAOCRIT,"IND",X))
QUIT
+7 ;criteria already in for occ
IF $DATA(^AQAOCC(5,"AC",AQAOIFN,AQAOCRIT))
QUIT
+8 KILL DIC,DR,DD,DO,DINUM
SET DIC(0)="L"
SET DIC=AQAOGBL
SET DLAYGO=AQAOFL
+9 SET DIC("DR")=".02////"_AQAOIFN_";.03////"_AQAOPAT
+10 SET X=AQAOCRIT
DO FILE^DICN
IF Y=-1
QUIT
+11 KILL DIE,DA,DR
SET DIE=AQAOGBL
SET DA=+Y
+12 SET DR=AQAOFLD_" FIRST]"
+13 DO ^DIE
End DoDot:1
+14 QUIT
