APCDPNAR.m

APCDPNAR ; IHS/CMI/LAB - EDIT PROVIDER NARRATIVE ;

 ;;2.0;IHS PCC SUITE;**10,11**;MAY 14, 2009;Build 58

EP ;

 ; APCDSWD=DICTIONARY NUMBER

 ; APCDSWCR=LINKING CROSS REFERENCE

 ; APCDSWV=VISIT DFN

 S APCDSWD=9000010.07

 S APCDSWCR="AD"

 S APCDSWV=APCDVSIT

 ;

 I $G(APCDVFIE)>0 S APCDLOOK=APCDVFIE Q

 S U="^"

 S APCDLOOK=""

 Q:'$D(APCDSWV)

 Q:APCDSWV=""

 Q:'$D(APCDSWD)

 Q:'APCDSWD

 Q:'$D(^DIC(APCDSWD,0,"GL"))

 S APCDSWG=^DIC(APCDSWD,0,"GL")

 I '$D(APCDSWCR),APCDSWD'=(APCDSWD\1),APCDSWD\1=9000010 S APCDSWCR="AD"

 I '$D(APCDSWCR),APCDSWD\1'=9000010 S APCDSWCR="AC"

 Q:'$D(APCDSWCR)

 Q:APCDSWCR=""

 W !

 S APCDSWDA=0 F APCDSWI=1:1 S APCDSWDA=$O(@(APCDSWG_""""_APCDSWCR_""",APCDSWV,APCDSWDA)")) Q:APCDSWDA=""  S DIC=APCDSWG,Y=APCDSWDA D GETVAL,WRITE

 S APCDSWI=APCDSWI-1

 S APCDSWAN="" ;S:APCDSWI=1 APCDSWAN=APCDSWI

RDR I APCDSWAN="",APCDSWI R !!,"Choose: ",APCDSWAN:$S($D(DTIME):DTIME,1:300)

 I APCDSWAN,$D(APCDSWT(APCDSWAN)) S APCDLOOK=APCDSWT(APCDSWAN)

 ;

 I APCDLOOK]"" I $P($G(^AUPNVPOV(APCDLOOK,11)),U,1) W !!,"This POV has been SNOMED coded, you cannot edit the narrative." G APCDPNAR

EDIT I APCDLOOK]"" S DIE=9000010.07,DR=".04;1218////^S X=$$NOW^XLFDT",DA=APCDLOOK D ^DIE K DIE,DA,DR G APCDPNAR  ;IHS/CMI/GRL

 ;

EXIT K APCDSWV,APCDSWVA,APCDSWL,APCDSWCR,APCDSWD,APCDSWG,APCDSWDA,APCDSWI,APCDSWAN,APCDSWT,APCDSWN,APCDSWEX,APCDSWL,APCDSWP,APCDSWZ,APCDSWD2,APCDSWG2,APCDSWV2,Y

 W !

 Q

 ;

GETVAL ;

 S APCDSWD2=APCDSWD,APCDSWG2=APCDSWG,APCDSWV2=APCDSWDA

 F APCDSWL=0:0 S APCDSWVA=$P(@(APCDSWG2_APCDSWV2_",0)"),U) Q:$P(@("^DD("_APCDSWD2_",.01,0)"),U,2)'["P"  S APCDSWG2=U_$P(^(0),U,3),APCDSWD2=+$P($P(^(0),U,2),"P",2),APCDSWV2=APCDSWVA

 Q

 ;

WRITE ;

 NEW P,Q

 W !,APCDSWI,"  ",APCDSWVA," ",?12,$$VAL^XBDIQ1(APCDSWD,Y,.04)

 W @("$E("_DIC_"Y,0),0)")   ;RESET NAKED REFERENCE

 S APCDSWN=0,APCDSWT(APCDSWI)=APCDSWDA F APCDSWL=0:0 S APCDSWN=$O(@("^DD("_APCDSWD_",0,""ID"",APCDSWN)")) Q:APCDSWN=""  S APCDSWEX=^(APCDSWN) W @("$E("_DIC_"Y,0),0)") X APCDSWEX

 Q

APCDPNAR  ; IHS/CMI/LAB - EDIT PROVIDER NARRATIVE ;

 +1       ;;2.0;IHS PCC SUITE;**10,11**;MAY 14, 2009;Build 58

EP        ;

 +1       ; APCDSWD=DICTIONARY NUMBER

 +2       ; APCDSWCR=LINKING CROSS REFERENCE

 +3       ; APCDSWV=VISIT DFN

 +4        SET APCDSWD=9000010.07

 +5        SET APCDSWCR="AD"

 +6        SET APCDSWV=APCDVSIT

 +7       ;

 +8        IF $GET(APCDVFIE)>0

               SET APCDLOOK=APCDVFIE

               QUIT 

 +9        SET U="^"

 +10       SET APCDLOOK=""

 +11       IF '$DATA(APCDSWV)

               QUIT 

 +12       IF APCDSWV=""

               QUIT 

 +13       IF '$DATA(APCDSWD)

               QUIT 

 +14       IF 'APCDSWD

               QUIT 

 +15       IF '$DATA(^DIC(APCDSWD,0,"GL"))

               QUIT 

 +16       SET APCDSWG=^DIC(APCDSWD,0,"GL")

 +17       IF '$DATA(APCDSWCR)

               IF APCDSWD'=(APCDSWD\1)

                   IF APCDSWD\1=9000010

                       SET APCDSWCR="AD"

 +18       IF '$DATA(APCDSWCR)

               IF APCDSWD\1'=9000010

                   SET APCDSWCR="AC"

 +19       IF '$DATA(APCDSWCR)

               QUIT 

 +20       IF APCDSWCR=""

               QUIT 

 +21       WRITE !

 +22       SET APCDSWDA=0

           FOR APCDSWI=1:1

               SET APCDSWDA=$ORDER(@(APCDSWG_""""_APCDSWCR_""",APCDSWV,APCDSWDA)"))

               IF APCDSWDA=""

                   QUIT 

               SET DIC=APCDSWG

               SET Y=APCDSWDA

               DO GETVAL

               DO WRITE

 +23       SET APCDSWI=APCDSWI-1

 +24      ;S:APCDSWI=1 APCDSWAN=APCDSWI

           SET APCDSWAN=""

RDR        IF APCDSWAN=""

               IF APCDSWI

                   READ !!,"Choose: ",APCDSWAN:$SELECT($DATA(DTIME):DTIME,1:300)

 +1        IF APCDSWAN

               IF $DATA(APCDSWT(APCDSWAN))

                   SET APCDLOOK=APCDSWT(APCDSWAN)

 +2       ;

 +3        IF APCDLOOK]""

               IF $PIECE($GET(^AUPNVPOV(APCDLOOK,11)),U,1)

                   WRITE !!,"This POV has been SNOMED coded, you cannot edit the narrative."

                   GOTO APCDPNAR

EDIT      ;IHS/CMI/GRL

           IF APCDLOOK]""

               SET DIE=9000010.07

               SET DR=".04;1218////^S X=$$NOW^XLFDT"

               SET DA=APCDLOOK

               DO ^DIE

               KILL DIE,DA,DR

               GOTO APCDPNAR

 +1       ;

EXIT       KILL APCDSWV,APCDSWVA,APCDSWL,APCDSWCR,APCDSWD,APCDSWG,APCDSWDA,APCDSWI,APCDSWAN,APCDSWT,APCDSWN,APCDSWEX,APCDSWL,APCDSWP,APCDSWZ,APCDSWD2,APCDSWG2,APCDSWV2,Y

 +1        WRITE !

 +2        QUIT 

 +3       ;

GETVAL    ;

 +1        SET APCDSWD2=APCDSWD

           SET APCDSWG2=APCDSWG

           SET APCDSWV2=APCDSWDA

 +2        FOR APCDSWL=0:0

               SET APCDSWVA=$PIECE(@(APCDSWG2_APCDSWV2_",0)"),U)

               IF $PIECE(@("^DD("_APCDSWD2_",.01,0)"),U,2)'["P"

                   QUIT 

               SET APCDSWG2=U_$PIECE(^(0),U,3)

               SET APCDSWD2=+$PIECE($PIECE(^(0),U,2),"P",2)

               SET APCDSWV2=APCDSWVA

 +3        QUIT 

 +4       ;

WRITE     ;

 +1        NEW P,Q

 +2        WRITE !,APCDSWI,"  ",APCDSWVA," ",?12,$$VAL^XBDIQ1(APCDSWD,Y,.04)

 +3       ;RESET NAKED REFERENCE

           WRITE @("$E("_DIC_"Y,0),0)")

 +4        SET APCDSWN=0

           SET APCDSWT(APCDSWI)=APCDSWDA

           FOR APCDSWL=0:0

               SET APCDSWN=$ORDER(@("^DD("_APCDSWD_",0,""ID"",APCDSWN)"))

               IF APCDSWN=""

                   QUIT 

               SET APCDSWEX=^(APCDSWN)

               WRITE @("$E("_DIC_"Y,0),0)")

               XECUTE APCDSWEX

 +5        QUIT