Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AQAOEDTP

AQAOEDTP.m

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