APCDEA3.m

APCDEA3 ; IHS/CMI/LAB - PROCESS MNEMONICS ;

 ;;2.0;IHS PCC SUITE;**11,16**;MAY 14, 2009;Build 9

 ;  Process MNEMONIC [ 07/01/86  12:45 PM ]

 ;

 ; *** WARNING *** This routine is called by non APCD routines.

EN ;PEP - CALLED TO PROCESS 1 MNEMONIC

 ;

DIC ; CREATE/LOOKUP ENTRY

 S APCDTMOD=$P(^APCDTKW(APCDMNE,0),U,2)

 S:APCDTMOD="" APCDTMOD=APCDMODE

 I APCDMODE="M" S DIC="^AUPNPAT("

 E  S DIC=^DIC($P(^APCDTKW(APCDMNE,0),U,3),0,"GL")

 I DIC="^AUPNPAT(" S Y=APCDPAT G DIE

 I APCDMODE="A",DIC="^AUPNVSIT(" S Y=APCDVSIT G DIE

 S:APCDTMOD="A" DLAYGO=$P(^APCDTKW(APCDMNE,0),U,3),DIC(0)="AEMQL"

 S DIC("DR")=""

 D ^DIC K DIC

 Q:Y<0

DIE ; ADD/MODIFY FIELDS IN ENTRY

 S APCDX=$P(^APCDTKW(APCDMNE,0),U,5) I APCDX]"" S APCDX="S APCDLOOK="_APCDX X APCDX

 K APCDX,DIV,DIU

 S (DA,D0)=+Y,DIE=DIC,DR=$P(^APCDTKW(APCDMNE,0),U,4),DR=$P(DR,"]")_" "_$S(APCDTMOD="A":"(ADD)",APCDTMOD="M":"(MOD)",1:"("_APCDMNE("NAME")_")")_"]"

 S:APCDMODE="A" DIE("NO^")=1

 S:DR["PV " DIE("NO^")=1

 D ^DIE K APCDCLN,APCDLOOK,DIE("NO^"),DIV,DIU,DIC,DIE,DIK

 I $G(APCDVSIT) S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT K AUPNVSIT

 I $D(Y) W APCDBEEP,!,"An error has occurred, I think!",!

DELETE ; DELETE ENTRY IF ^DIE FAILED IN ADD MODE

 I $D(APCDREGU) S DFN=APCDPAT D UPDATE^AGED K APCDREGU

 ;   AND NOT SWITCHING FROM PATIENT OR VISIT

 ;***** THIS SUCKER IS DANGEROUS *****

 ;I $D(Y),APCDTMOD="A",DIE'="^AUPNPAT(",DIE'="^AUPNVSIT(" S DIK=DIE D ^DIK

 K APCDTMOD,APCDX,APCDLOOK

 Q

GETNARR(APCDT,APCDDEFV) ;PEP - called to get a narrative

 ;because I have absolutely no idea where this call is coming from

 ;I am going to do an exclusive new to preserve the callers

 ;symbol table

 NEW APCDNQV

 S APCDNQV=""

 S APCDDEFV=$G(APCDDEFV)

 S APCDT=$G(APCDT)

 D EN^XBNEW("GETNARR1^APCDEA3","APCDT;APCDNQV;APCDDEFV")

 Q APCDNQV

GETNARR1 ;EP

 ;if user enters "=" use T IF T is not null

 ;do not allow "|"

 ;do not allow "@"

 NEW DA,DIR

 S T=$G(T)

 S DIR(0)="F^1:160",DIR("A")="  PROVIDER NARRATIVE" S:APCDDEFV]"" DIR("B")=APCDDEFV KILL DA D ^DIR KILL DIR

 I $D(DIRUT),X="^" W !!," ^ is Not Allowed.  Response is required.",! G GETNARR1

 I $D(DIRUT) Q ""

 I X="=",APCDT="" W "  ????" G GETNARR1

 I X="=",APCDT]"" S X=APCDT

 I $L(X)>160!($L(X)<2)!'((X'?1P.E)!(X?1"|".E))!(X'?.ANP)  W "  ????" G GETNARR1

 I X["|" W !!,"You cannot enter a narrative that contains a '|' (vertical bar).",! K X G GETNARR1

 S APCDNQV=X

 Q

APCDEA3   ; IHS/CMI/LAB - PROCESS MNEMONICS ;

 +1       ;;2.0;IHS PCC SUITE;**11,16**;MAY 14, 2009;Build 9

 +2       ;  Process MNEMONIC [ 07/01/86  12:45 PM ]

 +3       ;

 +4       ; *** WARNING *** This routine is called by non APCD routines.

EN        ;PEP - CALLED TO PROCESS 1 MNEMONIC

 +1       ;

DIC       ; CREATE/LOOKUP ENTRY

 +1        SET APCDTMOD=$PIECE(^APCDTKW(APCDMNE,0),U,2)

 +2        IF APCDTMOD=""

               SET APCDTMOD=APCDMODE

 +3        IF APCDMODE="M"

               SET DIC="^AUPNPAT("

 +4       IF '$TEST

               SET DIC=^DIC($PIECE(^APCDTKW(APCDMNE,0),U,3),0,"GL")

 +5        IF DIC="^AUPNPAT("

               SET Y=APCDPAT

               GOTO DIE

 +6        IF APCDMODE="A"

               IF DIC="^AUPNVSIT("

                   SET Y=APCDVSIT

                   GOTO DIE

 +7        IF APCDTMOD="A"

               SET DLAYGO=$PIECE(^APCDTKW(APCDMNE,0),U,3)

               SET DIC(0)="AEMQL"

 +8        SET DIC("DR")=""

 +9        DO ^DIC

           KILL DIC

 +10       IF Y<0

               QUIT 

DIE       ; ADD/MODIFY FIELDS IN ENTRY

 +1        SET APCDX=$PIECE(^APCDTKW(APCDMNE,0),U,5)

           IF APCDX]""

               SET APCDX="S APCDLOOK="_APCDX

               XECUTE APCDX

 +2        KILL APCDX,DIV,DIU

 +3        SET (DA,D0)=+Y

           SET DIE=DIC

           SET DR=$PIECE(^APCDTKW(APCDMNE,0),U,4)

           SET DR=$PIECE(DR,"]")_" "_$SELECT(APCDTMOD="A":"(ADD)",APCDTMOD="M":"(MOD)",1:"("_APCDMNE("NAME")_")")_"]"

 +4        IF APCDMODE="A"

               SET DIE("NO^")=1

 +5        IF DR["PV "

               SET DIE("NO^")=1

 +6        DO ^DIE

           KILL APCDCLN,APCDLOOK,DIE("NO^"),DIV,DIU,DIC,DIE,DIK

 +7        IF $GET(APCDVSIT)

               SET AUPNVSIT=APCDVSIT

               DO MOD^AUPNVSIT

               KILL AUPNVSIT

 +8        IF $DATA(Y)

               WRITE APCDBEEP,!,"An error has occurred, I think!",!

DELETE    ; DELETE ENTRY IF ^DIE FAILED IN ADD MODE

 +1        IF $DATA(APCDREGU)

               SET DFN=APCDPAT

               DO UPDATE^AGED

               KILL APCDREGU

 +2       ;   AND NOT SWITCHING FROM PATIENT OR VISIT

 +3       ;***** THIS SUCKER IS DANGEROUS *****

 +4       ;I $D(Y),APCDTMOD="A",DIE'="^AUPNPAT(",DIE'="^AUPNVSIT(" S DIK=DIE D ^DIK

 +5        KILL APCDTMOD,APCDX,APCDLOOK

 +6        QUIT 

GETNARR(APCDT,APCDDEFV) ;PEP - called to get a narrative

 +1       ;because I have absolutely no idea where this call is coming from

 +2       ;I am going to do an exclusive new to preserve the callers

 +3       ;symbol table

 +4        NEW APCDNQV

 +5        SET APCDNQV=""

 +6        SET APCDDEFV=$GET(APCDDEFV)

 +7        SET APCDT=$GET(APCDT)

 +8        DO EN^XBNEW("GETNARR1^APCDEA3","APCDT;APCDNQV;APCDDEFV")

 +9        QUIT APCDNQV

GETNARR1  ;EP

 +1       ;if user enters "=" use T IF T is not null

 +2       ;do not allow "|"

 +3       ;do not allow "@"

 +4        NEW DA,DIR

 +5        SET T=$GET(T)

 +6        SET DIR(0)="F^1:160"

           SET DIR("A")="  PROVIDER NARRATIVE"

           IF APCDDEFV]""

               SET DIR("B")=APCDDEFV

           KILL DA

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               IF X="^"

                   WRITE !!," ^ is Not Allowed.  Response is required.",!

                   GOTO GETNARR1

 +8        IF $DATA(DIRUT)

               QUIT ""

 +9        IF X="="

               IF APCDT=""

                   WRITE "  ????"

                   GOTO GETNARR1

 +10       IF X="="

               IF APCDT]""

                   SET X=APCDT

 +11       IF $LENGTH(X)>160!($LENGTH(X)<2)!'((X'?1P.E)!(X?1"|".E))!(X'?.ANP)

               WRITE "  ????"

               GOTO GETNARR1

 +12       IF X["|"

               WRITE !!,"You cannot enter a narrative that contains a '|' (vertical bar).",!

               KILL X

               GOTO GETNARR1

 +13       SET APCDNQV=X

 +14       QUIT