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