Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRAPKLG

LRAPKLG.m

Go to the documentation of this file.
  1. LRAPKLG ;DSS/FHS - MOVE SP DATA FROM SURGICAL RECORD ;09/21/16 10:44
  1. ;;5.2;LAB SERVICE;**462**;Sep 27, 1994;Build 44
  1. ; Supported calls AI #, 5286,103,3615
  1. EN ;
  1. ; Called from MOVE^LRAPKOE
  1. ; Call with
  1. ; LRDFN - LRSS - LRIDT - LRCDT
  1. Q:$P(^LR(LRDFN,0),U,2)'=2
  1. N A,ANS,CASE,CNT,CNTX,D0,DA,DIC,DIR,DIRUT,DR,DTOUT,DUOUT
  1. N ERR,FDA,FIL,FLD,IEN,LRABORT,LRCASE,LRDIAL,LRDOC,LREDT
  1. N LREND,LRFHDR,LRHDR,LRI,LRIEN,LRLONG,LROK,LROPER,LROPERS
  1. N LROPS,LRPAGE,LRPRAC,LROTHER,LRSCAN,LRRB,LRSCAN
  1. N LRSDATE,LRSDOC,LRSDT,LRSDX
  1. N LRSTAT,LRSTATUS,LRSURGDT,LRSURPHY,LRTN,LRTREA,LRV,LRVAL
  1. N LRWRD,LRX,LRYN,S,STR,VADM,VA,VAL,VAIN,X,Y
  1. EN0 ;
  1. S LROK=0
  1. S:'$G(DFN) DFN=$P(^LR(LRDFN,0),U,3) D PT^LRX
  1. I '$O(^SRF("ADT",DFN,0)) W !,"No Surgery Case for "_PNM Q
  1. S LREDT=9999999.999999-$$FMADD^XLFDT(DT,-7) ; End Date
  1. S LRSDT=9999999.999999-$$NOW^XLFDT ;Start Date
  1. W @IOF,!!,"Checking surgical record for this patient...",!
  1. W PNM," ",$P(VADM(5),U,2)," DOB:",$$FMTE^XLFDT($P(VADM(3),U),5)," SSN:",$P(VADM(2),U,2),!
  1. S CNT=0 F S LRSDT=$O(^SRF("ADT",DFN,LRSDT)) Q:'LRSDT!(LRSDT>LREDT) S LRCASE=0 F S LRCASE=$O(^SRF("ADT",DFN,LRSDT,LRCASE)) Q:'LRCASE D LIST
  1. EN1 ;
  1. ;
  1. I CNT=0 W !,"No operations on record in the past 7 days.",! Q
  1. I CNT=1 D Q
  1. . W @IOF
  1. . W !,"Only one operation on record available",! H 3
  1. . S (LRTN,LRCASE)=+LRCASE(1) D DISPLAY(LRCASE)
  1. . I '$G(LROK) D END Q
  1. . I $G(LROK) D STORE^LRAPKLG1(LRDFN,LRSS,LRIDT,.LRHDR)
  1. ;
  1. OPT K DIR S DIR("?",1)="Enter the number of the operation associated with the specimen(s)",DIR("?")="or press RETURN to bypass operation selection."
  1. W ! S DIR("A")="Select operation associated with the specimen(s)",DIR(0)="NO^1:"_CNT
  1. D ^DIR I $D(DTOUT)!$D(DUOUT) Q
  1. I +Y S LRTN=+LRCASE(+Y),CNT=+Y
  1. NOOP I '$D(LRTN) W !!,"No operation selected.",! Q
  1. S LRCASE=LRTN
  1. W $$CJ^XLFSTR("Entry from Surgery Case #"_LRTN,IOM),!
  1. DOC S LRDOC=$S($P($G(^SRF(LRTN,"NON")),U)="Y":$P(^("NON"),U,6),1:$P($G(^SRF(LRTN,.1)),U,4))
  1. DISP I $D(LRTN) S LRCASE=LRTN,LRSDATE=$P(^SRF(LRTN,0),U,9) D DISPLAY(LRCASE)
  1. I $G(LROK) D STORE^LRAPKLG1(LRDFN,LRSS,LRIDT,.LRHDR)
  1. I '$G(LROK) D END
  1. Q
  1. LIST ; list cases
  1. W !
  1. S LRSCAN=1 I $P($G(^SRF(LRCASE,.2)),U,10)!$P($G(^SRF(LRCASE,.2)),U,12)!($P($G(^SRF(LRCASE,"NON")),U)="Y") K LRSCAN
  1. I $D(LRSCAN),$D(^SRF(LRCASE,30)),$P(^(30),U) Q
  1. I $D(LRSCAN),$D(^SRF(LRCASE,31)),$P(^(31),U,8) Q
  1. I $D(^SRF(LRCASE,37)),$P(^(37),U) Q
  1. S CNT=+$G(CNT)+1,LRSDATE=$P(^SRF(LRCASE,0),U,9) W !,CNT_". "
  1. S LRSDX=$$FMTE^XLFDT(LRSDATE,"5P")
  1. CASE W "D/T:"_LRSDX_" "
  1. N LRI,LRVAL,LROPS
  1. S LROPER=$P(^SRF(LRCASE,"OP"),U)
  1. I $O(^SRF(LRCASE,13,0)) S LROTHER=0 D
  1. . F S LROTHER=$O(^SRF(LRCASE,13,LROTHER)) Q:'LROTHER D OTHER
  1. S LROPER="Case #"_LRCASE_" >> "_LROPER
  1. D STATUS^LRAPKLG1(LRCASE)
  1. S:$L(LROPER)<65 LROPS(1)=LROPER
  1. I $L(LROPER)>64 S LROPER=LROPER_" " F LRI=1:1 D LOOK Q:LRVAL(1)=""
  1. W ?14,LROPS(1) I $D(LROPS(2)) W !,?14,LROPS(2) I $D(LROPS(3)) W !,?14,LROPS(3) W:$D(LROPS(4)) !,?14,LROPS(4)
  1. S LRCASE(CNT)=LRCASE_U_LRSDX_U_LRSURPHY
  1. Q
  1. OTHER ; Check for other operations
  1. ;^DD(130,.42
  1. S LRLONG=1 I $L(LROPER)+$L($P(^SRF(LRCASE,13,LROTHER,0),U))>235 S LRLONG=0,LROTHER=999,LROPERS=" ..."
  1. I LRLONG S LROPERS=$P(^SRF(LRCASE,13,LROTHER,0),U)
  1. S LROPER=LROPER_$S(LROPERS=" ...":LROPERS,1:", "_LROPERS)
  1. Q
  1. LOOK ; parse out procedures
  1. S LROPS(LRI)="" F S LRVAL=$P(LROPER," "),LRVAL(1)=$P(LROPER," ",2,200) Q:LRVAL(1)="" Q:$L(LROPS(LRI))+$L(LRVAL)'<65 S LROPS(LRI)=LROPS(LRI)_LRVAL_" ",LROPER=LRVAL(1)
  1. ;
  1. Q
  1. ;
  1. DISPLAY(LRCASE) ;Display the Dialog for a Surgery case
  1. ;Call with Surgery Case # ^SRF(LRCASE#)
  1. ;LRHDR array contains the Surgery Package dialog
  1. ;Where "X" = array subscript
  1. ;LRHDR(33,X)="Preoperative diagnosis"
  1. ;LRHDR(34,X)="Post Opertive Diag"
  1. ;LRHDR(38,X)="Operative Finding"
  1. ;LRHDR(39,X)="Brief Clinical History" DD(63.08,.013)
  1. N CNT,DIC,DA,DR,S,LRLN,LRPAGE,IEN,LREND,LRSDOC,VAL
  1. S $P(LRLN," ",IOM)=" "
  1. S LRSDOC=$S($P($G(^SRF(LRCASE,"NON")),U)="Y":$P(^("NON"),U,6),1:$P($G(^SRF(LRCASE,.1)),U,4))
  1. S LREND=0
  1. D HDR,PRTHDR
  1. ;
  1. S LRHDR(1)=$$FMT(" ===== Above From Surgery Case#: "_LRCASE_" =====",IOM)
  1. S LRHDR(2)=LRLN
  1. S CNT=0
  1. ;BRIEF CLINICAL HISTORY:
  1. I $O(^SRF(LRCASE,39,0)) D
  1. . S (CNT,CNTX,IEN)=0,LRHDR=$$FMT(" Brief Clinical History",IOM) D
  1. . . W !,LRHDR," ",!
  1. . . F S IEN=$O(^SRF(LRCASE,39,IEN)) Q:IEN<1!($G(LREND)) S VAL=^(IEN,0) D
  1. . . . S VAL=$$FMT(VAL,IOM)
  1. . . . W VAL,! S (CNTX,CNT)=CNT+1,LRHDR(39,CNT)=VAL
  1. D PAGE
  1. Q:$G(LREND)
  1. I $G(CNTX) D FOOT(39,CNTX)
  1. ;
  1. ;Pre-Operative Diagnosis
  1. I $P($G(^SRF(LRCASE,33)),U)'="" K CNTX D
  1. . D PAGE Q:LREND
  1. . S LRHDR=$$FMT(" Pre-Operative Diagnosis:",IOM),CNTX=0
  1. . W !,LRHDR,!
  1. . S CNT=1,VAL=$$FMT($P(^SRF(LRCASE,33),U),IOM),LRHDR(33,CNT)=VAL W VAL,!
  1. . D PAGE Q:$G(LREND) S CNTX=CNT
  1. . N IEN
  1. . Q:'$O(^SRF(LRCASE,14,0)) ;Get additional Preop diagnosis
  1. . S LRHDR=$$FMT(" Additional Pre-Operative Diagnosis",IOM) W !,LRHDR,!
  1. . S IEN=0 F S IEN=$O(^SRF(LRCASE,14,IEN)) Q:IEN<1!($G(LREND)) D
  1. . . Q:$P($G(^SRF(LRCASE,14,IEN,0)),U)=""
  1. . . S VAL=$$FMT($P(^SRF(LRCASE,14,IEN,0),U),IOM)
  1. . . S (CNTX,CNT)=CNT+1,LRHDR(33,CNT)=VAL W VAL,!
  1. . . D PAGE
  1. Q:$G(LREND)
  1. I $G(CNTX) D FOOT(33,CNTX)
  1. ;Operative findings
  1. S (CNT,CNTX,IEN)=0,LRHDR=$$FMT(" Operative Finding",IOM) I $O(^SRF(LRCASE,38,0)) D
  1. . D PAGE Q:$G(LREND)
  1. . W !,LRHDR," ",!
  1. . D PAGE Q:$G(LREND)
  1. . F S IEN=$O(^SRF(LRCASE,38,IEN)) Q:IEN<1!($G(LREND)) S VAL=^(IEN,0) D
  1. . . S VAL=$$FMT(VAL,IOM)
  1. . . W VAL,! S (CNTX,CNT)=CNT+1,LRHDR(38,CNT)=VAL D PAGE Q:$G(LREND)
  1. I $G(CNTX) D FOOT(38,CNTX)
  1. Q:$G(LREND)
  1. K CNT,CNTX,VAL
  1. ;Post Operative Diagnosis
  1. I $P($G(^SRF(LRCASE,34)),U)'="" S CNT=1 D
  1. . S VAL=$$FMT($P(^SRF(LRCASE,34),U),IOM)
  1. . S LRHDR(34,CNT)=VAL
  1. . S LRHDR=$$FMT(" Post Operative Diagnosis",IOM),CNTX=CNT
  1. . D PAGE Q:LREND
  1. . W !,LRHDR,!
  1. . W VAL,!
  1. . N IEN
  1. . S IEN=0 F S IEN=$O(^SRF(LRCASE,15,IEN)) Q:IEN<1!$G(LREND) D
  1. . . Q:$P($G(^SRF(LRCASE,15,IEN,0)),U)=""
  1. . . S VAL=$$FMT($P(^SRF(LRCASE,15,IEN,0),U),IOM)
  1. . . S (CNTX,CNT)=CNT+1,LRHDR(34,CNT)=VAL
  1. . . W VAL,! D PAGE
  1. Q:$G(LREND)
  1. I $G(CNTX) D FOOT(34,CNTX)
  1. D YN("Move this information into Laboratory Patient Record File")
  1. Q
  1. PAGE ;End of page prompt
  1. Q:$Y<(IOSL-2)
  1. S LREND=0
  1. K DTOUT,DUOUT,DIRUT,Y,DIR
  1. S DIR(0)="E" D ^DIR
  1. I Y=0 S LREND=1 Q
  1. I Y=1 D PRTHDR
  1. Q
  1. HDR ;Setup Header information
  1. S LRSURPHY="DR:"_$$GET1^DIQ(200,LRSDOC_",",.01,"ANS","ERR")
  1. S LRSURGDT=$$FMTE^XLFDT($P(^SRF(LRCASE,0),U,9),"1P")_" DOB: "_$$FMTE^XLFDT(DOB,2)
  1. S LRHDR(0)=PNM_" SSN:"_SSN_" CASE# "_LRCASE
  1. S LRHDR(0,1)=" Surgery Date:"_LRSURGDT_" "_LRSURPHY
  1. Q
  1. PRTHDR ; Print report header info
  1. S LRPAGE=$G(LRPAGE)+1
  1. W:'$G(LRFHDR) !!!
  1. W:$G(LRFHDR) @IOF
  1. S LRFHDR=1
  1. W $$CJ^XLFSTR("PG:"_LRPAGE_" "_LRHDR(0),IOM)
  1. W !,$$CJ^XLFSTR(LRHDR(0,1),IOM),!
  1. Q
  1. YN(STR) ;Yes No response
  1. N DTOUT,DUOUT,DIRUT,X,Y,DIR
  1. S LROK=0,LREND=1
  1. S DIR(0)="Y",DIR("A")=STR,DIR("B")="No"
  1. D ^DIR
  1. S:+$G(Y)=1 LROK=1,LREND=0
  1. Q
  1. END ;User Termination Response
  1. W !,$$CJ^XLFSTR("No Surgery Data was transferred",IOM),!
  1. Q
  1. FMT(VAL,IOM) ;Format line to IOM length
  1. Q VAL
  1. W "+" I $L(VAL)>71 Q VAL
  1. I VAL="" S VAL=" "
  1. S VAL=VAL_$E(LRLN,$L(VAL),71)
  1. Q VAL
  1. S LRX=LRX+1,LRHDR(SEG,LRX)=LRHDR(1)
  1. S LRX=LRX+1,LRHDR(SEG,LRX)=LRHDR(2)
  1. Q