BLRCCPED ; IHS/MSC/MKK - CC Parameter EDit ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
PEP ; EP
CHANGE ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
S HEADER(1)="IHS Laboratory"
S HEADER(2)="BLR CC DATA Parameter"
S HEADER(3)=$$CJ^XLFSTR("Modify Value",IOM)
;
S RESULT=$$GET^XPAR("PKG","BLR CC DATA",1,"Q")
S RESULT=$S(RESULT:"YES",RESULT=0:"NO",1:"")
;
D HEADERDT^BLRGMENU
;
D ^XBFMK
S DIR(0)="YO"
S DIR("A")="BLR CC DATA (YES/NO)"
S:$L(RESULT) DIR("B")=RESULT
D ^DIR
;
I +$G(DIRUT)!($G(Y)="") D Q
. W !!,?4,"Invalid/No Entry/Quit. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
;
S ANSWER=$S($E(X)="Y":"YES",1:"NO")
;
D EN^XPAR("PKG","BLR CC DATA",,ANSWER,.ERRS)
;
D:+$G(ERRS)>0 RPTERR(ERRS)
;
Q
;
RPTERR(ERROR) ; EP
NEW ERRDESC,ERRNUM,NOWH
;
S ERRNUM=$P(ERROR,"^")
S ERRDESC=$P(ERROR,"^",2)
;
W !!,"*** ERROR Modifying BLR CC DATA paramter. ***",!!
W ?4,"Error Number:",ERRNUM,!
W:$L(ERRDESC)<50 ?9,"Description:",ERRDESC
I $L(ERRDESC)>49 D LINEWRAP^BLRGMENU(9,ERRDESC,60)
W !
;
D PRESSKEY^BLRGMENU(9)
;
S NOWH=$H
S:$D(^XTMP("BLRCCPED"))<1 XTMP("BLRCCPED")="^"_$$DT^XLFDT_"^Errors Modifying BLR CC DATA Parameter"
S $P(^XTMP("BLRCCPED"),"^")=$$HTFM^XLFDT(+$H+30)
;
M ^XTMP("BLRCCPED",NOWH,"01","DUZ")=DUZ
S ^XTMP("BLRCCPED",NOWH,"02","ERROR")=ERROR
;
Q
;
GETCCDTO(LRODT,LRSP,LRTST) ; EP - Get CC Data; called from LROW2A
NEW LRAA,LRAD,LRAN,LRDFN,LRSS,LRIDT
;
S STR=$G(^LRO(69,LRODT,1,LRSP,2,LRTST,0))
S LRAA=+$P(STR,"^",4) Q:$L(LRAA)<1
;
S LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
Q:$L(LRSS)<1
;
S LRAD=+$P(STR,"^",3),LRAN=+$P(STR,"^",5)
S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=+$P($G(^(3)),"^",5)
Q:LRDFN<1!(LRIDT<1)
;
D GETCCDTA(LRDFN,LRSS,LRIDT)
Q
;
GETCCDTA(LRDFN,LRSS,LRIDT) ; EP - Get CC Data; Called from LRVER4
NEW CCIEN,CCNAME,CCSTR,FDA,ERRS,HEADER,IENS,RESULT,WOTSUBF
;
;
; S HEADER(1)="IHS Laboratory"
; S HEADER(2)="BLR CC DATA Parameter"
;
S RESULT=+$$GET^XPAR("PKG","BLR CC DATA",1,"Q")
Q:'RESULT
;
D ^XBFMK
S DIR(0)="YO"
; S DIR("A")="CC Patient's Accession Data"
S DIR("A")="CC Patient Results"
S DIR("B")="NO"
D ^DIR
Q:+$D(DIRUT)!(+$G(Y)<1)
;
W !!
;
D ^XBFMK
S DIR(0)="PO^200:E"
S DIR("A")="Provider to CC"
D ^DIR
I +$D(DIRUT)!($G(X)="") D
. W !,?4,"Invalid/No/Quit Input. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
;
S CCIEN=+Y,CCNAME=$P(Y,"^",2)
S CCSTR=CCNAME_"!"_CCIEN_"!"_DUZ_"!"_$$NOW^XLFDT
;
; Set Sub-File Number
S WOTSUBF=$S(LRSS="CH":63.04,LRSS="MI":63.05)
;
S IENS=","_LRIDT_","_LRDFN_","
S FDA(WOTSUBF,IENS,9999992)=CCSTR
D UPDATE^DIE("S","FDA",,"ERRS")
;
Q
;
YEXPORTD(LRDFN,LRSS,LRIDT) ; EP - Put YES into EXPORTED DATA field in file 63
NEW ERRS,FDA,IENS
;
S IENS=LRIDT_","_LRDFN_","
;
; Set Sub-File Number
S WOTSUBF=$S(LRSS="CH":63.04,LRSS="MI":63.05)
;
S FDA(WOTSUBF,IENS,"EXPORTED DATA")="Y"
D UPDATE^DIE("S","FDA",,"ERRS")
Q
;
AYEXPORT(LRAS) ; EP - Given an accession number, call YEXPORTD
NEW IENS,LRAA,LRAD,LRAN,LRDFN,LRIDT,LRSS
;
Q:$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1
;
S LRSS=$$GET1^DIQ(68,LRAA,"LR SUBSCRIPT","I")
S IENS=LRAN_","_LRAD_","_LRAA
S LRDFN=$$GET1^DIQ(68.02,IENS,"LRDFN")
S LRIDT=$$GET1^DIQ(68.02,IENS,"INVERSE DATE","I")
;
D YEXPORTD(LRDFN,LRSS,LRIDT)
Q
;
UYEXPORT(UID) ; EP - Given an UID, call YEXPORTD
NEW IENS,LRAA,LRAD,LRAN,LRDFN,LRIDT,LRSS
D RETACCV^BLRUTIL4(UID,.LRAA,.LRAD,.LRAN,.LRDFN,.LRSS,.LRIDT)
S LRSS=$$GET1^DIQ(68,LRAA,.02,"I") ; Need to reset LRSS
;
D YEXPORTD(LRDFN,LRSS,LRIDT)
Q
BLRCCPED ; IHS/MSC/MKK - CC Parameter EDit ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
PEP ; EP
CHANGE ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 SET HEADER(1)="IHS Laboratory"
+4 SET HEADER(2)="BLR CC DATA Parameter"
+5 SET HEADER(3)=$$CJ^XLFSTR("Modify Value",IOM)
+6 ;
+7 SET RESULT=$$GET^XPAR("PKG","BLR CC DATA",1,"Q")
+8 SET RESULT=$SELECT(RESULT:"YES",RESULT=0:"NO",1:"")
+9 ;
+10 DO HEADERDT^BLRGMENU
+11 ;
+12 DO ^XBFMK
+13 SET DIR(0)="YO"
+14 SET DIR("A")="BLR CC DATA (YES/NO)"
+15 IF $LENGTH(RESULT)
SET DIR("B")=RESULT
+16 DO ^DIR
+17 ;
+18 IF +$GET(DIRUT)!($GET(Y)="")
Begin DoDot:1
+19 WRITE !!,?4,"Invalid/No Entry/Quit. Routine Ends."
+20 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+21 ;
+22 SET ANSWER=$SELECT($EXTRACT(X)="Y":"YES",1:"NO")
+23 ;
+24 DO EN^XPAR("PKG","BLR CC DATA",,ANSWER,.ERRS)
+25 ;
+26 IF +$GET(ERRS)>0
DO RPTERR(ERRS)
+27 ;
+28 QUIT
+29 ;
RPTERR(ERROR) ; EP
+1 NEW ERRDESC,ERRNUM,NOWH
+2 ;
+3 SET ERRNUM=$PIECE(ERROR,"^")
+4 SET ERRDESC=$PIECE(ERROR,"^",2)
+5 ;
+6 WRITE !!,"*** ERROR Modifying BLR CC DATA paramter. ***",!!
+7 WRITE ?4,"Error Number:",ERRNUM,!
+8 IF $LENGTH(ERRDESC)<50
WRITE ?9,"Description:",ERRDESC
+9 IF $LENGTH(ERRDESC)>49
DO LINEWRAP^BLRGMENU(9,ERRDESC,60)
+10 WRITE !
+11 ;
+12 DO PRESSKEY^BLRGMENU(9)
+13 ;
+14 SET NOWH=$HOROLOG
+15 IF $DATA(^XTMP("BLRCCPED"))<1
SET XTMP("BLRCCPED")="^"_$$DT^XLFDT_"^Errors Modifying BLR CC DATA Parameter"
+16 SET $PIECE(^XTMP("BLRCCPED"),"^")=$$HTFM^XLFDT(+$HOROLOG+30)
+17 ;
+18 MERGE ^XTMP("BLRCCPED",NOWH,"01","DUZ")=DUZ
+19 SET ^XTMP("BLRCCPED",NOWH,"02","ERROR")=ERROR
+20 ;
+21 QUIT
+22 ;
GETCCDTO(LRODT,LRSP,LRTST) ; EP - Get CC Data; called from LROW2A
+1 NEW LRAA,LRAD,LRAN,LRDFN,LRSS,LRIDT
+2 ;
+3 SET STR=$GET(^LRO(69,LRODT,1,LRSP,2,LRTST,0))
+4 SET LRAA=+$PIECE(STR,"^",4)
IF $LENGTH(LRAA)<1
QUIT
+5 ;
+6 SET LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
+7 IF $LENGTH(LRSS)<1
QUIT
+8 ;
+9 SET LRAD=+$PIECE(STR,"^",3)
SET LRAN=+$PIECE(STR,"^",5)
+10 SET LRDFN=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
SET LRIDT=+$PIECE($GET(^(3)),"^",5)
+11 IF LRDFN<1!(LRIDT<1)
QUIT
+12 ;
+13 DO GETCCDTA(LRDFN,LRSS,LRIDT)
+14 QUIT
+15 ;
GETCCDTA(LRDFN,LRSS,LRIDT) ; EP - Get CC Data; Called from LRVER4
+1 NEW CCIEN,CCNAME,CCSTR,FDA,ERRS,HEADER,IENS,RESULT,WOTSUBF
+2 ;
+3 ;
+4 ; S HEADER(1)="IHS Laboratory"
+5 ; S HEADER(2)="BLR CC DATA Parameter"
+6 ;
+7 SET RESULT=+$$GET^XPAR("PKG","BLR CC DATA",1,"Q")
+8 IF 'RESULT
QUIT
+9 ;
+10 DO ^XBFMK
+11 SET DIR(0)="YO"
+12 ; S DIR("A")="CC Patient's Accession Data"
+13 SET DIR("A")="CC Patient Results"
+14 SET DIR("B")="NO"
+15 DO ^DIR
+16 IF +$DATA(DIRUT)!(+$GET(Y)<1)
QUIT
+17 ;
+18 WRITE !!
+19 ;
+20 DO ^XBFMK
+21 SET DIR(0)="PO^200:E"
+22 SET DIR("A")="Provider to CC"
+23 DO ^DIR
+24 IF +$DATA(DIRUT)!($GET(X)="")
Begin DoDot:1
+25 WRITE !,?4,"Invalid/No/Quit Input. Routine Ends."
+26 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
+27 ;
+28 SET CCIEN=+Y
SET CCNAME=$PIECE(Y,"^",2)
+29 SET CCSTR=CCNAME_"!"_CCIEN_"!"_DUZ_"!"_$$NOW^XLFDT
+30 ;
+31 ; Set Sub-File Number
+32 SET WOTSUBF=$SELECT(LRSS="CH":63.04,LRSS="MI":63.05)
+33 ;
+34 SET IENS=","_LRIDT_","_LRDFN_","
+35 SET FDA(WOTSUBF,IENS,9999992)=CCSTR
+36 DO UPDATE^DIE("S","FDA",,"ERRS")
+37 ;
+38 QUIT
+39 ;
YEXPORTD(LRDFN,LRSS,LRIDT) ; EP - Put YES into EXPORTED DATA field in file 63
+1 NEW ERRS,FDA,IENS
+2 ;
+3 SET IENS=LRIDT_","_LRDFN_","
+4 ;
+5 ; Set Sub-File Number
+6 SET WOTSUBF=$SELECT(LRSS="CH":63.04,LRSS="MI":63.05)
+7 ;
+8 SET FDA(WOTSUBF,IENS,"EXPORTED DATA")="Y"
+9 DO UPDATE^DIE("S","FDA",,"ERRS")
+10 QUIT
+11 ;
AYEXPORT(LRAS) ; EP - Given an accession number, call YEXPORTD
+1 NEW IENS,LRAA,LRAD,LRAN,LRDFN,LRIDT,LRSS
+2 ;
+3 IF $$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1
QUIT
+4 ;
+5 SET LRSS=$$GET1^DIQ(68,LRAA,"LR SUBSCRIPT","I")
+6 SET IENS=LRAN_","_LRAD_","_LRAA
+7 SET LRDFN=$$GET1^DIQ(68.02,IENS,"LRDFN")
+8 SET LRIDT=$$GET1^DIQ(68.02,IENS,"INVERSE DATE","I")
+9 ;
+10 DO YEXPORTD(LRDFN,LRSS,LRIDT)
+11 QUIT
+12 ;
UYEXPORT(UID) ; EP - Given an UID, call YEXPORTD
+1 NEW IENS,LRAA,LRAD,LRAN,LRDFN,LRIDT,LRSS
+2 DO RETACCV^BLRUTIL4(UID,.LRAA,.LRAD,.LRAN,.LRDFN,.LRSS,.LRIDT)
+3 ; Need to reset LRSS
SET LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
+4 ;
+5 DO YEXPORTD(LRDFN,LRSS,LRIDT)
+6 QUIT
