APCDSMA ;IHS/CMI/LAB - LIST MANAGER MAP ADVICE DISPLAY
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;; ;
EP ;
D EN^XBNEW("EN^APCDSMA","APCDSMC,APCDLOOK,APCDSMA")
Q
EN ;EP -- main entry point for
NEW APCDFHSN,APCDHIGH,APCDTCI,APCDTDI,I
D EN^VALM("APCD MAP ADVICE DISPLAY")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
EOJ ;
K APCDSMA
Q
;
HDR ; -- header code
S VALMHDR(1)="Map Advice for Concept ID "_APCDSMC
S VALMHDR(2)="Provider Narrative: "_$$VAL^XBDIQ1(9000010.07,APCDLOOK,.04)
S VALMHDR(3)="FSN: "_$P($$CONC^AUPNVUTL(APCDSMC),U,2)
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)
Q
;
INIT ;EP --
NEW C,X
K APCDSMD
S X=0,C=0 F S X=$O(APCDSMA(X)) Q:X'=+X D
.S C=C+1
.S APCDSMD(C,0)=APCDSMA(X)
.S APCDSMD("IDX",C,C)=APCDSMA(X)
S VALMCNT=C
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
;
SELECT ;EP - add an item to the selected list - called from a protocol
W !
S DIR(0)="NO^1:"_APCDHIGH,DIR("A")="Which SNOMED Term"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No SNOMED selected." G DISPX
I $D(DIRUT) W !,"No SNOMED selected." G DISPX
S APCDCI=$P(APCDFHSN("IDX",Y,Y),U,2)
S APCDDI=$P(APCDFHSN("IDX",Y,Y),U,3)
;W !!,$$CONC^AUPNSICD(APCDCI_"^^"_$S($G(APCDDATE):APCDDATE,1:DT)_"^1") H 10
S APCDICD=$P($P($$CONC^AUPNSICD(APCDCI_"^^"_$S($G(APCDDATE):APCDDATE,1:DT)_"^1"),U,5),";")
K ^TMP($J,"APCDFHSNOMED"),APCDFHSN
Q
;
DISPX ;
D BACK
Q
APCDSMA ;IHS/CMI/LAB - LIST MANAGER MAP ADVICE DISPLAY
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;; ;
EP ;
+1 DO EN^XBNEW("EN^APCDSMA","APCDSMC,APCDLOOK,APCDSMA")
+2 QUIT
EN ;EP -- main entry point for
+1 NEW APCDFHSN,APCDHIGH,APCDTCI,APCDTDI,I
+2 DO EN^VALM("APCD MAP ADVICE DISPLAY")
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 IF $DATA(IOF)
WRITE @IOF
+6 DO EOJ
+7 QUIT
EOJ ;
+1 KILL APCDSMA
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Map Advice for Concept ID "_APCDSMC
+2 SET VALMHDR(2)="Provider Narrative: "_$$VAL^XBDIQ1(9000010.07,APCDLOOK,.04)
+3 SET VALMHDR(3)="FSN: "_$PIECE($$CONC^AUPNVUTL(APCDSMC),U,2)
+4 SET 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)
+5 QUIT
+6 ;
INIT ;EP --
+1 NEW C,X
+2 KILL APCDSMD
+3 SET X=0
SET C=0
FOR
SET X=$ORDER(APCDSMA(X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET C=C+1
+5 SET APCDSMD(C,0)=APCDSMA(X)
+6 SET APCDSMD("IDX",C,C)=APCDSMA(X)
End DoDot:1
+7 SET VALMCNT=C
+8 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
+8 ;
SELECT ;EP - add an item to the selected list - called from a protocol
+1 WRITE !
+2 SET DIR(0)="NO^1:"_APCDHIGH
SET DIR("A")="Which SNOMED Term"
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF Y=""
WRITE !,"No SNOMED selected."
GOTO DISPX
+5 IF $DATA(DIRUT)
WRITE !,"No SNOMED selected."
GOTO DISPX
+6 SET APCDCI=$PIECE(APCDFHSN("IDX",Y,Y),U,2)
+7 SET APCDDI=$PIECE(APCDFHSN("IDX",Y,Y),U,3)
+8 ;W !!,$$CONC^AUPNSICD(APCDCI_"^^"_$S($G(APCDDATE):APCDDATE,1:DT)_"^1") H 10
+9 SET APCDICD=$PIECE($PIECE($$CONC^AUPNSICD(APCDCI_"^^"_$SELECT($GET(APCDDATE):APCDDATE,1:DT)_"^1"),U,5),";")
+10 KILL ^TMP($JOB,"APCDFHSNOMED"),APCDFHSN
+11 QUIT
+12 ;
DISPX ;
+1 DO BACK
+2 QUIT