- 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
