APCDSMA.m

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