BJPNVFIL ;GDIT/HS/BEE-Prenatal Care Module V OB Handling ; 08 May 2012 12:00 PM
;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
;
Q
;
VFILE(PLIEN,VFILE) ;EP - Log V OB Entry
;
;Input Parameters:
; PLIEN - Pointer to #90680.01
; VFILE("DFN") - Pointer to #9000001
; VFILE("VIEN") - Pointer to #9000010
; VFILE("POV") - Used as POV (Y)
; VFILE("PRIORITY") - Priority (L/M/H)
; VFILE("PTEXT") - Pointer to #9999999.27
; VFILE("SCOPE") - Scope (A/C)
; VFILE("STATUS") - Status (A/I)
; VFILE("DEDD") - Definitive EDD
; VFILE("NOTE") - Single Note
; VFILE("TNOTE") - Technical Note Header
; VFILE("TNOTE",fien) - Technical Notes - fields changed
; VFILE("OEDT") - Original Entry Date
; VFILE("OEBY") - Original Entry By
; VFILE("LMDT") - Last Modified Date
; VFILE("LMBY") - Last Modified By
; VFILE("DEBY") - Deleted By
; VFILE("DEDT") - Deleted Dt
; VFILE("DECD") - Deleted Code
; VFILE("DERN") - Deleted Reason
;
NEW DFN,DIC,DLAYGO,X,Y,PPROV,BJPNLM,BJPNUPD,ERROR,EVDT,OEDATA,PNARR
NEW DIK,DA,VPIEN,VNIEN,VIEN,SNPTR
;
S DIC="^AUPNVOB("
S DLAYGO=9000010.43,DIC("P")=DLAYGO,DIC(0)="LOX"
S X=PLIEN
K DO,DD D FILE^DICN
S VPIEN=+Y
S VIEN=$G(VFILE("VIEN"))
;
;Pull DFN
S DFN=$G(VFILE("DFN"))
;
;Pull OE Into
S OEDATA=$$OEDATA(DFN,PLIEN)
I $G(VFILE("OEDT"))="" D
. S VFILE("OEDT")=$P(OEDATA,U)
. S VFILE("OEBY")=$P(OEDATA,U,2)
;
;.02 PATIENT NAME
S BJPNUPD(9000010.43,VPIEN_",",".02")=VFILE("DFN")
;
;.03 VISIT
S BJPNUPD(9000010.43,VPIEN_",",".03")=VFILE("VIEN")
;
;.05 USED AS POV
I $G(VFILE("POV"))]"" S BJPNUPD(9000010.43,VPIEN_",",".05")=VFILE("POV")
;
;.06 PRIORITY
I $G(VFILE("PRIORITY"))]"" S BJPNUPD(9000010.43,VPIEN_",",".06")=VFILE("PRIORITY")
;
;.07 PROVIDER TEXT
I $G(VFILE("PTEXT"))]"" S BJPNUPD(9000010.43,VPIEN_",",".07")=VFILE("PTEXT")
;
;.08 SCOPE
I $G(VFILE("SCOPE"))]"" S BJPNUPD(9000010.43,VPIEN_",",".08")=VFILE("SCOPE")
;
;.09 STATUS
I $G(VFILE("STATUS"))]"" S BJPNUPD(9000010.43,VPIEN_",",".09")=VFILE("STATUS")
;
;.1 DEFINITIVE EDD
I $G(VFILE("DEDD"))]"" S BJPNUPD(9000010.43,VPIEN_",",".1")=VFILE("DEDD")
;
;.11 PROVIDER NARRATIVE
S PNARR="" D
. NEW PTEXT,DIC,DLAYGO,X,Y
. S PTEXT="" I $G(VFILE("PTEXT"))]"" S PTEXT=$$GET1^DIQ(9999999.27,VFILE("PTEXT")_",",.01,"E")
. S PNARR=$$GET1^DIQ(90680.01,PLIEN_",",.03,"I")
. S PNARR=$$GET1^DIQ(90680.02,PNARR_",",.02,"E")
. S PNARR=PNARR_"| "_PTEXT
. S DIC(0)="LX",DIC="^AUTNPOV(",DLAYGO=9999999.27,X=PNARR
. D ^DIC
. S PNARR=+Y
;S DIC("DR")=DIC("DR")_";.11////"_PNARR
S BJPNUPD(9000010.43,VPIEN_",",".11")=PNARR
;
;.12 SNOMED TERM
S SNPTR=$$GET1^DIQ(90680.01,PLIEN_",",.03,"I")
S BJPNUPD(9000010.43,VPIEN_",",".12")=SNPTR
;
;1201 EVENT DATE AND TIME
S EVDT=$$GET1^DIQ(9000010,VFILE("VIEN")_",",.01,"I")
I EVDT]"" S BJPNUPD(9000010.43,VPIEN_",","1201")=EVDT
;
;Ordering Provider
;S PPROV=$$PPRV^BJPNPKL(VIEN)
;I PPROV]"" S BJPNUPD(9000010.43,VPIEN_",","1202")=PPROV
;
;1204 ENCOUNTER PROVIDER
S BJPNUPD(9000010.43,VPIEN_",","1204")=DUZ ;Set to current user
;
;1216 DATE/TIME ENTERED
I $G(VFILE("OEDT"))]"" S BJPNUPD(9000010.43,VPIEN_",","1216")=VFILE("OEDT")
;
;1217 ENTERED BY
I $G(VFILE("OEBY"))]"" S BJPNUPD(9000010.43,VPIEN_",","1217")=VFILE("OEBY")
;
;2.01 PROBLEM DELETED BY
I $G(VFILE("DEBY"))]"" S BJPNUPD(9000010.43,VPIEN_",",2.01)=VFILE("DEBY")
;
;2.02 DATE/TIME PROBLEM DELETED
I $G(VFILE("DEDT"))]"" S BJPNUPD(9000010.43,VPIEN_",",2.02)=VFILE("DEDT")
;
;2.03 REASON PROBLEM DELETED
I $G(VFILE("DECD"))]"" S BJPNUPD(9000010.43,VPIEN_",",2.03)=VFILE("DECD")
;
;2.04 DELETE REASON IF OTHER
I $G(VFILE("DERN"))]"" S BJPNUPD(9000010.43,VPIEN_",",2.04)=VFILE("DERN")
;
I $D(BJPNUPD) D FILE^DIE("","BJPNUPD","ERROR")
I $D(ERROR) Q "-1^^V OB FILE SAVE FAILED"
;
;File last modified dt/by separately - Avoid duplicate index issue
;
;1218 DATE/TIME LAST MODIFIED
I $G(VFILE("LMDT"))]"" S BJPNLM(9000010.43,VPIEN_",","1218")=VFILE("LMDT")
;
;1219 LAST MODIFIED BY
I $G(VFILE("LMDY"))]"" S BJPNLM(9000010.43,VPIEN_",","1219")=VFILE("LMBY")
;
I $D(BJPNLM) D FILE^DIE("","BJPNLM","ERROR")
I $D(ERROR) Q "-1^^V OB FILE SAVE FAILED"
;
;File Note
I $G(VFILE("NOTE"))]"" S VNIEN=$$ANOTE^BJPNPRUT(VPIEN,VFILE("NOTE")) D I VNIEN=-1 Q "-1^^V OB NOTE SAVE FAILED"
. Q:VNIEN=-1
. I $G(VNIEN)]"" S VFILE("TNOTE",2100)=VNIEN
;
;2200 TECHNICAL COMMENT
I $D(VFILE("TNOTE")) D TNOTE(VPIEN,.VFILE)
;
;Reindex this entry
S DIK="^AUPNVOB(",DA=VPIEN D IX^DIK
;
Q VPIEN
;
TNOTE(VPIEN,VFL) ;EP - File TNOTES
;
I $G(VPIEN)="" Q
;
NEW HDR,FLD
;
;Look for header first
S HDR=$G(VFL("TNOTE")) I HDR]"" D
. NEW DA,DIC,DLAYGO,X,Y
. S DIC="^AUPNVOB("_VPIEN_",22,",DA(1)=VPIEN
. S DLAYGO=9000010.4311,DIC("P")=DLAYGO,DIC(0)="LOX"
. S X="C"
. S DIC("DR")=".02////"_HDR
. K DO,DD D FILE^DICN
;
;Save other modified entries
S FLD="" F S FLD=$O(VFL("TNOTE",FLD)) Q:FLD="" D
. I (FLD="1.01")!(FLD="1.02")!(FLD="1.03")!(FLD="1.4") Q
. NEW DA,DIC,DLAYGO,X,Y
. S DIC="^AUPNVOB("_VPIEN_",22,",DA(1)=VPIEN
. S DLAYGO=9000010.4311,DIC("P")=DLAYGO,DIC(0)="LOX"
. S X="F"
. S DIC("DR")=".02////"_FLD_$S(FLD=2100:":"_VFL("TNOTE",FLD),1:"")
. K DO,DD D FILE^DICN
;
;Save last modified fields
F FLD=1.01,1.02,1.03,1.04 I $D(VFL("TNOTE",FLD)) D
. NEW DA,DIC,DLAYGO,X,Y
. S DIC="^AUPNVOB("_VPIEN_",22,",DA(1)=VPIEN
. S DLAYGO=9000010.4311,DIC("P")=DLAYGO,DIC(0)="LOX"
. S X="F"
. S DIC("DR")=".02////"_FLD
. K DO,DD D FILE^DICN
;
Q
;
OEDATA(DFN,PLIEN) ;EP - Retrieve Original Entry information for problem
;
I $G(DFN)="" Q ""
I $G(PLIEN)="" Q ""
;
NEW VN,VFIEN,OEDT,OEBY
S (OEDT,OEBY,VN)="" F S VN=$O(^AUPNVOB("AA",DFN,PLIEN,VN)) Q:VN="" D
. S VFIEN="" F S VFIEN=$O(^AUPNVOB("AA",DFN,PLIEN,VN,VFIEN)) Q:VFIEN="" D
.. NEW CRDT
.. S CRDT=$$GET1^DIQ(9000010.43,VFIEN_",",1216,"I") Q:CRDT=""
.. I OEDT]"",CRDT>OEDT Q
.. S OEDT=CRDT
.. S OEBY=$$GET1^DIQ(9000010.43,VFIEN_",",1217,"I")
;
Q OEDT_U_OEBY
;
VFADD(APCDPIP,APCDVSIT) ;EP - Add placeholder entry to V OB file
;
;This function adds a basic entry into the V OB file which is then updated
;by the [APCDALVR 9000010.43 (ADD)] Template
;
NEW DFN,DIC,DLAYGO,X,Y
;
I $G(APCDPIP)="" Q ""
I $G(APCDVSIT)="" Q ""
;
S DIC="^AUPNVOB(",DLAYGO=9000010.43,DIC("P")=DLAYGO,DIC(0)="LOX"
S X=$G(APCDPIP)
S DFN=$$GET1^DIQ(9000010,APCDVSIT_",",".05","I")
S DIC("DR")=".02////"_DFN_";.03////"_APCDVSIT
K DO,DD D FILE^DICN
S Y=$S(+Y>0:+Y,1:"")
Q Y
;
PNARR(NARR) ;EP - Save new PROVIDER NARRATIVE (#9999999.27) entry
;
I $G(NARR)="" Q ""
;
NEW DIC,DLAYGO,X,Y
;
S DIC(0)="LX",DIC="^AUTNPOV(",DLAYGO=9999999.27,X=NARR
D ^DIC
Q $S(+Y<0:"",1:+Y)
BJPNVFIL ;GDIT/HS/BEE-Prenatal Care Module V OB Handling ; 08 May 2012 12:00 PM
+1 ;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
+2 ;
+3 QUIT
+4 ;
VFILE(PLIEN,VFILE) ;EP - Log V OB Entry
+1 ;
+2 ;Input Parameters:
+3 ; PLIEN - Pointer to #90680.01
+4 ; VFILE("DFN") - Pointer to #9000001
+5 ; VFILE("VIEN") - Pointer to #9000010
+6 ; VFILE("POV") - Used as POV (Y)
+7 ; VFILE("PRIORITY") - Priority (L/M/H)
+8 ; VFILE("PTEXT") - Pointer to #9999999.27
+9 ; VFILE("SCOPE") - Scope (A/C)
+10 ; VFILE("STATUS") - Status (A/I)
+11 ; VFILE("DEDD") - Definitive EDD
+12 ; VFILE("NOTE") - Single Note
+13 ; VFILE("TNOTE") - Technical Note Header
+14 ; VFILE("TNOTE",fien) - Technical Notes - fields changed
+15 ; VFILE("OEDT") - Original Entry Date
+16 ; VFILE("OEBY") - Original Entry By
+17 ; VFILE("LMDT") - Last Modified Date
+18 ; VFILE("LMBY") - Last Modified By
+19 ; VFILE("DEBY") - Deleted By
+20 ; VFILE("DEDT") - Deleted Dt
+21 ; VFILE("DECD") - Deleted Code
+22 ; VFILE("DERN") - Deleted Reason
+23 ;
+24 NEW DFN,DIC,DLAYGO,X,Y,PPROV,BJPNLM,BJPNUPD,ERROR,EVDT,OEDATA,PNARR
+25 NEW DIK,DA,VPIEN,VNIEN,VIEN,SNPTR
+26 ;
+27 SET DIC="^AUPNVOB("
+28 SET DLAYGO=9000010.43
SET DIC("P")=DLAYGO
SET DIC(0)="LOX"
+29 SET X=PLIEN
+30 KILL DO,DD
DO FILE^DICN
+31 SET VPIEN=+Y
+32 SET VIEN=$GET(VFILE("VIEN"))
+33 ;
+34 ;Pull DFN
+35 SET DFN=$GET(VFILE("DFN"))
+36 ;
+37 ;Pull OE Into
+38 SET OEDATA=$$OEDATA(DFN,PLIEN)
+39 IF $GET(VFILE("OEDT"))=""
Begin DoDot:1
+40 SET VFILE("OEDT")=$PIECE(OEDATA,U)
+41 SET VFILE("OEBY")=$PIECE(OEDATA,U,2)
End DoDot:1
+42 ;
+43 ;.02 PATIENT NAME
+44 SET BJPNUPD(9000010.43,VPIEN_",",".02")=VFILE("DFN")
+45 ;
+46 ;.03 VISIT
+47 SET BJPNUPD(9000010.43,VPIEN_",",".03")=VFILE("VIEN")
+48 ;
+49 ;.05 USED AS POV
+50 IF $GET(VFILE("POV"))]""
SET BJPNUPD(9000010.43,VPIEN_",",".05")=VFILE("POV")
+51 ;
+52 ;.06 PRIORITY
+53 IF $GET(VFILE("PRIORITY"))]""
SET BJPNUPD(9000010.43,VPIEN_",",".06")=VFILE("PRIORITY")
+54 ;
+55 ;.07 PROVIDER TEXT
+56 IF $GET(VFILE("PTEXT"))]""
SET BJPNUPD(9000010.43,VPIEN_",",".07")=VFILE("PTEXT")
+57 ;
+58 ;.08 SCOPE
+59 IF $GET(VFILE("SCOPE"))]""
SET BJPNUPD(9000010.43,VPIEN_",",".08")=VFILE("SCOPE")
+60 ;
+61 ;.09 STATUS
+62 IF $GET(VFILE("STATUS"))]""
SET BJPNUPD(9000010.43,VPIEN_",",".09")=VFILE("STATUS")
+63 ;
+64 ;.1 DEFINITIVE EDD
+65 IF $GET(VFILE("DEDD"))]""
SET BJPNUPD(9000010.43,VPIEN_",",".1")=VFILE("DEDD")
+66 ;
+67 ;.11 PROVIDER NARRATIVE
+68 SET PNARR=""
Begin DoDot:1
+69 NEW PTEXT,DIC,DLAYGO,X,Y
+70 SET PTEXT=""
IF $GET(VFILE("PTEXT"))]""
SET PTEXT=$$GET1^DIQ(9999999.27,VFILE("PTEXT")_",",.01,"E")
+71 SET PNARR=$$GET1^DIQ(90680.01,PLIEN_",",.03,"I")
+72 SET PNARR=$$GET1^DIQ(90680.02,PNARR_",",.02,"E")
+73 SET PNARR=PNARR_"| "_PTEXT
+74 SET DIC(0)="LX"
SET DIC="^AUTNPOV("
SET DLAYGO=9999999.27
SET X=PNARR
+75 DO ^DIC
+76 SET PNARR=+Y
End DoDot:1
+77 ;S DIC("DR")=DIC("DR")_";.11////"_PNARR
+78 SET BJPNUPD(9000010.43,VPIEN_",",".11")=PNARR
+79 ;
+80 ;.12 SNOMED TERM
+81 SET SNPTR=$$GET1^DIQ(90680.01,PLIEN_",",.03,"I")
+82 SET BJPNUPD(9000010.43,VPIEN_",",".12")=SNPTR
+83 ;
+84 ;1201 EVENT DATE AND TIME
+85 SET EVDT=$$GET1^DIQ(9000010,VFILE("VIEN")_",",.01,"I")
+86 IF EVDT]""
SET BJPNUPD(9000010.43,VPIEN_",","1201")=EVDT
+87 ;
+88 ;Ordering Provider
+89 ;S PPROV=$$PPRV^BJPNPKL(VIEN)
+90 ;I PPROV]"" S BJPNUPD(9000010.43,VPIEN_",","1202")=PPROV
+91 ;
+92 ;1204 ENCOUNTER PROVIDER
+93 ;Set to current user
SET BJPNUPD(9000010.43,VPIEN_",","1204")=DUZ
+94 ;
+95 ;1216 DATE/TIME ENTERED
+96 IF $GET(VFILE("OEDT"))]""
SET BJPNUPD(9000010.43,VPIEN_",","1216")=VFILE("OEDT")
+97 ;
+98 ;1217 ENTERED BY
+99 IF $GET(VFILE("OEBY"))]""
SET BJPNUPD(9000010.43,VPIEN_",","1217")=VFILE("OEBY")
+100 ;
+101 ;2.01 PROBLEM DELETED BY
+102 IF $GET(VFILE("DEBY"))]""
SET BJPNUPD(9000010.43,VPIEN_",",2.01)=VFILE("DEBY")
+103 ;
+104 ;2.02 DATE/TIME PROBLEM DELETED
+105 IF $GET(VFILE("DEDT"))]""
SET BJPNUPD(9000010.43,VPIEN_",",2.02)=VFILE("DEDT")
+106 ;
+107 ;2.03 REASON PROBLEM DELETED
+108 IF $GET(VFILE("DECD"))]""
SET BJPNUPD(9000010.43,VPIEN_",",2.03)=VFILE("DECD")
+109 ;
+110 ;2.04 DELETE REASON IF OTHER
+111 IF $GET(VFILE("DERN"))]""
SET BJPNUPD(9000010.43,VPIEN_",",2.04)=VFILE("DERN")
+112 ;
+113 IF $DATA(BJPNUPD)
DO FILE^DIE("","BJPNUPD","ERROR")
+114 IF $DATA(ERROR)
QUIT "-1^^V OB FILE SAVE FAILED"
+115 ;
+116 ;File last modified dt/by separately - Avoid duplicate index issue
+117 ;
+118 ;1218 DATE/TIME LAST MODIFIED
+119 IF $GET(VFILE("LMDT"))]""
SET BJPNLM(9000010.43,VPIEN_",","1218")=VFILE("LMDT")
+120 ;
+121 ;1219 LAST MODIFIED BY
+122 IF $GET(VFILE("LMDY"))]""
SET BJPNLM(9000010.43,VPIEN_",","1219")=VFILE("LMBY")
+123 ;
+124 IF $DATA(BJPNLM)
DO FILE^DIE("","BJPNLM","ERROR")
+125 IF $DATA(ERROR)
QUIT "-1^^V OB FILE SAVE FAILED"
+126 ;
+127 ;File Note
+128 IF $GET(VFILE("NOTE"))]""
SET VNIEN=$$ANOTE^BJPNPRUT(VPIEN,VFILE("NOTE"))
Begin DoDot:1
+129 IF VNIEN=-1
QUIT
+130 IF $GET(VNIEN)]""
SET VFILE("TNOTE",2100)=VNIEN
End DoDot:1
IF VNIEN=-1
QUIT "-1^^V OB NOTE SAVE FAILED"
+131 ;
+132 ;2200 TECHNICAL COMMENT
+133 IF $DATA(VFILE("TNOTE"))
DO TNOTE(VPIEN,.VFILE)
+134 ;
+135 ;Reindex this entry
+136 SET DIK="^AUPNVOB("
SET DA=VPIEN
DO IX^DIK
+137 ;
+138 QUIT VPIEN
+139 ;
TNOTE(VPIEN,VFL) ;EP - File TNOTES
+1 ;
+2 IF $GET(VPIEN)=""
QUIT
+3 ;
+4 NEW HDR,FLD
+5 ;
+6 ;Look for header first
+7 SET HDR=$GET(VFL("TNOTE"))
IF HDR]""
Begin DoDot:1
+8 NEW DA,DIC,DLAYGO,X,Y
+9 SET DIC="^AUPNVOB("_VPIEN_",22,"
SET DA(1)=VPIEN
+10 SET DLAYGO=9000010.4311
SET DIC("P")=DLAYGO
SET DIC(0)="LOX"
+11 SET X="C"
+12 SET DIC("DR")=".02////"_HDR
+13 KILL DO,DD
DO FILE^DICN
End DoDot:1
+14 ;
+15 ;Save other modified entries
+16 SET FLD=""
FOR
SET FLD=$ORDER(VFL("TNOTE",FLD))
IF FLD=""
QUIT
Begin DoDot:1
+17 IF (FLD="1.01")!(FLD="1.02")!(FLD="1.03")!(FLD="1.4")
QUIT
+18 NEW DA,DIC,DLAYGO,X,Y
+19 SET DIC="^AUPNVOB("_VPIEN_",22,"
SET DA(1)=VPIEN
+20 SET DLAYGO=9000010.4311
SET DIC("P")=DLAYGO
SET DIC(0)="LOX"
+21 SET X="F"
+22 SET DIC("DR")=".02////"_FLD_$SELECT(FLD=2100:":"_VFL("TNOTE",FLD),1:"")
+23 KILL DO,DD
DO FILE^DICN
End DoDot:1
+24 ;
+25 ;Save last modified fields
+26 FOR FLD=1.01,1.02,1.03,1.04
IF $DATA(VFL("TNOTE",FLD))
Begin DoDot:1
+27 NEW DA,DIC,DLAYGO,X,Y
+28 SET DIC="^AUPNVOB("_VPIEN_",22,"
SET DA(1)=VPIEN
+29 SET DLAYGO=9000010.4311
SET DIC("P")=DLAYGO
SET DIC(0)="LOX"
+30 SET X="F"
+31 SET DIC("DR")=".02////"_FLD
+32 KILL DO,DD
DO FILE^DICN
End DoDot:1
+33 ;
+34 QUIT
+35 ;
OEDATA(DFN,PLIEN) ;EP - Retrieve Original Entry information for problem
+1 ;
+2 IF $GET(DFN)=""
QUIT ""
+3 IF $GET(PLIEN)=""
QUIT ""
+4 ;
+5 NEW VN,VFIEN,OEDT,OEBY
+6 SET (OEDT,OEBY,VN)=""
FOR
SET VN=$ORDER(^AUPNVOB("AA",DFN,PLIEN,VN))
IF VN=""
QUIT
Begin DoDot:1
+7 SET VFIEN=""
FOR
SET VFIEN=$ORDER(^AUPNVOB("AA",DFN,PLIEN,VN,VFIEN))
IF VFIEN=""
QUIT
Begin DoDot:2
+8 NEW CRDT
+9 SET CRDT=$$GET1^DIQ(9000010.43,VFIEN_",",1216,"I")
IF CRDT=""
QUIT
+10 IF OEDT]""
IF CRDT>OEDT
QUIT
+11 SET OEDT=CRDT
+12 SET OEBY=$$GET1^DIQ(9000010.43,VFIEN_",",1217,"I")
End DoDot:2
End DoDot:1
+13 ;
+14 QUIT OEDT_U_OEBY
+15 ;
VFADD(APCDPIP,APCDVSIT) ;EP - Add placeholder entry to V OB file
+1 ;
+2 ;This function adds a basic entry into the V OB file which is then updated
+3 ;by the [APCDALVR 9000010.43 (ADD)] Template
+4 ;
+5 NEW DFN,DIC,DLAYGO,X,Y
+6 ;
+7 IF $GET(APCDPIP)=""
QUIT ""
+8 IF $GET(APCDVSIT)=""
QUIT ""
+9 ;
+10 SET DIC="^AUPNVOB("
SET DLAYGO=9000010.43
SET DIC("P")=DLAYGO
SET DIC(0)="LOX"
+11 SET X=$GET(APCDPIP)
+12 SET DFN=$$GET1^DIQ(9000010,APCDVSIT_",",".05","I")
+13 SET DIC("DR")=".02////"_DFN_";.03////"_APCDVSIT
+14 KILL DO,DD
DO FILE^DICN
+15 SET Y=$SELECT(+Y>0:+Y,1:"")
+16 QUIT Y
+17 ;
PNARR(NARR) ;EP - Save new PROVIDER NARRATIVE (#9999999.27) entry
+1 ;
+2 IF $GET(NARR)=""
QUIT ""
+3 ;
+4 NEW DIC,DLAYGO,X,Y
+5 ;
+6 SET DIC(0)="LX"
SET DIC="^AUTNPOV("
SET DLAYGO=9999999.27
SET X=NARR
+7 DO ^DIC
+8 QUIT $SELECT(+Y<0:"",1:+Y)
