- 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