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

APCDSMA.m

Go to the documentation of this file.
  1. APCDSMA ;IHS/CMI/LAB - LIST MANAGER MAP ADVICE DISPLAY
  1. ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1. ;; ;
  1. EP ;
  1. D EN^XBNEW("EN^APCDSMA","APCDSMC,APCDLOOK,APCDSMA")
  1. Q
  1. EN ;EP -- main entry point for
  1. NEW APCDFHSN,APCDHIGH,APCDTCI,APCDTDI,I
  1. D EN^VALM("APCD MAP ADVICE DISPLAY")
  1. D CLEAR^VALM1
  1. D FULL^VALM1
  1. W:$D(IOF) @IOF
  1. D EOJ
  1. Q
  1. EOJ ;
  1. K APCDSMA
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="Map Advice for Concept ID "_APCDSMC
  1. S VALMHDR(2)="Provider Narrative: "_$$VAL^XBDIQ1(9000010.07,APCDLOOK,.04)
  1. S VALMHDR(3)="FSN: "_$P($$CONC^AUPNVUTL(APCDSMC),U,2)
  1. S VALMHDR(4)="Patient's Age at visit: "_$$AGE^AUPNPAT($$VALI^XBDIQ1(9000010.07,APCDLOOK,.02),$$VD^APCLV($$VALI^XBDIQ1(9000010.07,APCDLOOK,.03)),"E")_" "_$$VAL^XBDIQ1(2,$$VALI^XBDIQ1(9000010.07,APCDLOOK,.02),.02)
  1. Q
  1. ;
  1. INIT ;EP --
  1. NEW C,X
  1. K APCDSMD
  1. S X=0,C=0 F S X=$O(APCDSMA(X)) Q:X'=+X D
  1. .S C=C+1
  1. .S APCDSMD(C,0)=APCDSMA(X)
  1. .S APCDSMD("IDX",C,C)=APCDSMA(X)
  1. S VALMCNT=C
  1. Q
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. BACK ;go back to listman
  1. D TERM^VALM0
  1. S VALMBCK="R"
  1. D INIT
  1. D HDR
  1. K DIR
  1. K X,Y,Z,I
  1. Q
  1. ;
  1. SELECT ;EP - add an item to the selected list - called from a protocol
  1. W !
  1. S DIR(0)="NO^1:"_APCDHIGH,DIR("A")="Which SNOMED Term"
  1. D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I Y="" W !,"No SNOMED selected." G DISPX
  1. I $D(DIRUT) W !,"No SNOMED selected." G DISPX
  1. S APCDCI=$P(APCDFHSN("IDX",Y,Y),U,2)
  1. S APCDDI=$P(APCDFHSN("IDX",Y,Y),U,3)
  1. ;W !!,$$CONC^AUPNSICD(APCDCI_"^^"_$S($G(APCDDATE):APCDDATE,1:DT)_"^1") H 10
  1. S APCDICD=$P($P($$CONC^AUPNSICD(APCDCI_"^^"_$S($G(APCDDATE):APCDDATE,1:DT)_"^1"),U,5),";")
  1. K ^TMP($J,"APCDFHSNOMED"),APCDFHSN
  1. Q
  1. ;
  1. DISPX ;
  1. D BACK
  1. Q