- LRHY0 ;DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:00am
- ;;5.2;LAB SERVICE;**405,435,446,457**;Sep 27, 1994;Build 6
- ;
- PICK ;
- ; pick the site from Howdy Site FILE 69.86
- S LREND=0
- S DIC(0)="AEMQZ"
- S DIC=69.86
- D ^DIC
- I Y=-1 S LREND=1 QUIT
- S LRHYSITE=+Y
- K DIC
- ;
- I $G(^LRHY(69.86,LRHYSITE,0))["ALTER" S LRDEV=$O(^%ZIS(1,"B","NULL DEVICE",0)) G ALT
- ;
- ; Pick a printer
- S LRDEV=0
- K DIC
- S DIC(0)="EMQZ" K Y S LRHYCT2=1
- F S LRDEV=$O(^LRHY(69.86,LRHYSITE,10,"B",LRDEV)) Q:+LRDEV'>0 D
- . W !,LRHYCT2,". ",$P(^%ZIS(1,LRDEV,0),U)
- . S LRX(LRHYCT2)=LRDEV S LRHYCT2=LRHYCT2+1
- CHOOO W !,"Choose a label printer: " R X:DTIME W !
- I U[X S LREND=1 QUIT
- I X="" W !,"NOTHING SELECTED" S LREND=1 H 1 QUIT
- I '$D(LRX(X)) W !,"NUMBER NOT IN RANGE" H 1 G CHOOO
- I U[X S LREND=1 QUIT
- I 'X I $G(X)'="" W !,"enter the number please" G CHOOO
- S LRDEV=LRX(X)
- ;
- ;
- ALT ;
- W ?11,$P(^%ZIS(1,LRDEV,0),U) H 2
- K DIC
- K LRHYCT2
- D USER^LRHYU
- ;
- ;
- QUIT
- ;
- VET ; Primary API for Howdy! Called by [LRHY PATIENT CARD SCAN] option.
- D XTMP^LRHYU
- N LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI
- N LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND
- N LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU
- N LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN
- N LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ
- N LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT
- N LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99
- N LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X
- ;
- VET1 ; Code below executes to handle Patient episode.
- ; Then, Howdy waits here for next Patient
- ;
- K LRCCOMX,LRDUX,LREDT,LRDX,DIK
- K LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3
- K LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT,LREXORD
- K LRMERG,LRODRNUM,LRORDNUM,LRUNC,LRPARAM
- K LRHYCT3,LRHYCTC,IOTLC,LRC,LRHYCT3,LRHYCTC,LRHYTOK,LRKIL,LRLABNOD
- K LRLABSTP,LRLINE,LRLWC,LRN5,LRNONONO,LRNOT,LRNOTEST,LRNOUP,LRNT,LRNX0
- K LRODRUM,LRONE,LRORDSIZ,LRORDT,LRORDT1,LRM1,LRM2,LRM3,LRPHONE,LRORIEN
- K LRS,LRSC0,LRSDT,LRSN1,LRSPIEN,LRSSN,LRSTAR,LRSTOP,LRSTUCK
- K LRT0,LRTECH,LRTKX,LRTM7,LRTOTAL,LRTST,LRTUBE,LRTXT,LRUDT,LRUNK,LRURG7
- K LRURGA,LRURGNCY,LRURGT,LRURGZ19,LRX1,LRX2,LRX3,LRY1,LRYTAT,LR3,LR3MULT
- K LR3NX0,LR3ODT,M9,V,LRHYORDZ
- K LABCNT,LN,LR0NODE,LR68,LR6987,LR700,LR7LESS
- K LR7MORE,LRAANAME,LRAAZ,LRAC1,LRACCER,LRACCTM,LRACCXX
- K LRACNODE,LRACO,LRACTM,LRADD,LRBAR0,LRBAR1,LRBBRD
- K LRBINGO,LRCEN,LRCNTX,LRCTYPE,LRD,LRDA,LRDRAW0
- K LRDRAW1,LRDRAW7,LRDT,LRDTX,LRDUP,LRDUX,LREDT,LRDX
- K LRFINX
- ;
- I '$G(LRDEV) D PICK Q:LREND
- ;
- K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD
- K ^TMP("LRHYDY",$J)
- D ^LRPARAM ; Set Howdy up as Lab user
- S LRHOWDY=1
- S LRHYCT=$G(LRHYCT,0)
- I LRHYCT=2 W !,"Please ask the clerk for assistance." K LRHYCT QUIT
- S LRODT=DT
- W @IOF
- K X
- ;
- W !!,"Please swipe your ID CARD or Type SSN: "
- ; %ZOSF("EOFF") = U $I:NOECHO
- ; %ZOSF("EON") = U $I:ECHO
- X ^%ZOSF("EOFF")
- R X:9999999 W !
- I X=U X ^%ZOSF("EON") D BAKUSER^LRHYU QUIT
- X ^%ZOSF("EON")
- ; Code is set to read all types of VIC card as of 9/05/2005
- ;I $E(X,1,9)["-" D
- ;. S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3)
- ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10)
- ;I $L(X)>10 S X=$E(X,2,10)
- ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET
- ;
- K DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT
- ;
- ;S DFN=$O(^DPT("SSN",X,0))
- ;
- ; NEW CODE FOR VIC 4.0
- D RPCVIC^DPTLK(.DFN,X)
- ;
- I DFN<1 W !,"No record for this person." R X:15 G VET1
- S LRDFN=$G(^DPT(DFN,"LR"))
- ;
- I LRDFN D PT^LRX
- I 'LRDFN W !,"No Lab Data Available... Please check with clerk at the Desk." H 5 D LOG K X G VET1
- K ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN)
- ;
- ; this call checks order against the 69.86
- D ORDCHK^LRHYB
- ;
- ;
- ;
- I $G(LRLOCS) W !!!,"Please check with clerk at the Desk" H 5 K X G QUITH
- I $G(LRMULT) W !!!,"Please check with clerk at the Desk" H 5 D LOG K X G QUITH
- I '$G(LRORD) S LREND=1 W !,$G(LRCTYPE)," No Orders found. Please check with clerk at the Desk" H 5 D LOG K X G QUITH
- D NOW^%DTC
- ;
- ;
- ;
- PRT1 ;
- ;
- W @IOF
- D SCRNON^LRHYUTL
- S PNMALL="Howdy "_$P(PNM,",",2)_" "_$P(PNM,",")
- W !
- W IODHLT," ",PNMALL
- W !
- W IODHLB," ",PNMALL
- W !
- W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,40)),IOM)
- W !,$$CJ^XLFSTR("Your Host is: "_$G(^LRHY(69.86,LRHYSITE,42)),IOM)
- W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,44)),IOM)
- W !
- W IODHLT," Orders for date: "_$$Y2K^LRX(DT)
- W !
- W IODHLB," Orders for date: "_$$Y2K^LRX(DT)
- W !
- S LRXYZ=0
- F S LRXYZ=$O(^LRHY(69.86,LRHYSITE,32,LRXYZ)) Q:+LRXYZ'>0 D
- . W !
- . W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,32,LRXYZ,0)),IOM)
- . W !
- W *7 H 1 W *7 H 1 W *7
- ;
- I $D(^LRHY(69.86,7,54,"B")) D BINBRD^LRHYBC1
- H 5
- QUITH ;
- D SCRNOFF^LRHYUTL ; Turn off screen variables
- K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD,LRHYCT
- K LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI
- K LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND
- K LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU
- K LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN,LREXORD
- K LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ
- K LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT
- K LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99
- K LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X,LRLOCS
- K VAIN
- ;
- ;
- G VET1
- ;
- ;
- ;
- ORDCHK ; This block to be used for future version
- QUIT
- LOG ; Howdy will default to the clerks judgement when multiple orders found.
- I $G(LRMULT) QUIT
- Q:$G(LRSKIPNO)
- ;
- W !,"NO ORDERS"
- ;
- K LRDPF,PNM
- D PT^LRX
- D NOW^%DTC
- I '$G(LRDFN) S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(DFN) QUIT
- S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN)
- QUIT
- ;
- ;
- LOG1 ; Howdy will default to the clerks judgement when multiple orders found.
- K LRORD,LRDPT,PNM
- W !,"MULTIPLE ORDERS"
- K LRDPF,PNM
- D PT^LRX
- D NOW^%DTC
- S ^TMP("LRHYDY",$J,"LR MULTIPLE ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN)
- S LRSKIPNO=1
- QUIT
- ORDERS ;
- QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHY0 6193 printed Feb 18, 2025@23:40:59 Page 2
- LRHY0 ;DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:00am
- +1 ;;5.2;LAB SERVICE;**405,435,446,457**;Sep 27, 1994;Build 6
- +2 ;
- PICK ;
- +1 ; pick the site from Howdy Site FILE 69.86
- +2 SET LREND=0
- +3 SET DIC(0)="AEMQZ"
- +4 SET DIC=69.86
- +5 DO ^DIC
- +6 IF Y=-1
- SET LREND=1
- QUIT
- +7 SET LRHYSITE=+Y
- +8 KILL DIC
- +9 ;
- +10 IF $GET(^LRHY(69.86,LRHYSITE,0))["ALTER"
- SET LRDEV=$ORDER(^%ZIS(1,"B","NULL DEVICE",0))
- GOTO ALT
- +11 ;
- +12 ; Pick a printer
- +13 SET LRDEV=0
- +14 KILL DIC
- +15 SET DIC(0)="EMQZ"
- KILL Y
- SET LRHYCT2=1
- +16 FOR
- SET LRDEV=$ORDER(^LRHY(69.86,LRHYSITE,10,"B",LRDEV))
- if +LRDEV'>0
- QUIT
- Begin DoDot:1
- +17 WRITE !,LRHYCT2,". ",$PIECE(^%ZIS(1,LRDEV,0),U)
- +18 SET LRX(LRHYCT2)=LRDEV
- SET LRHYCT2=LRHYCT2+1
- End DoDot:1
- CHOOO WRITE !,"Choose a label printer: "
- READ X:DTIME
- WRITE !
- +1 IF U[X
- SET LREND=1
- QUIT
- +2 IF X=""
- WRITE !,"NOTHING SELECTED"
- SET LREND=1
- HANG 1
- QUIT
- +3 IF '$DATA(LRX(X))
- WRITE !,"NUMBER NOT IN RANGE"
- HANG 1
- GOTO CHOOO
- +4 IF U[X
- SET LREND=1
- QUIT
- +5 IF 'X
- IF $GET(X)'=""
- WRITE !,"enter the number please"
- GOTO CHOOO
- +6 SET LRDEV=LRX(X)
- +7 ;
- +8 ;
- ALT ;
- +1 WRITE ?11,$PIECE(^%ZIS(1,LRDEV,0),U)
- HANG 2
- +2 KILL DIC
- +3 KILL LRHYCT2
- +4 DO USER^LRHYU
- +5 ;
- +6 ;
- +7 QUIT
- +8 ;
- VET ; Primary API for Howdy! Called by [LRHY PATIENT CARD SCAN] option.
- +1 DO XTMP^LRHYU
- +2 NEW LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI
- +3 NEW LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND
- +4 NEW LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU
- +5 NEW LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN
- +6 NEW LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ
- +7 NEW LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT
- +8 NEW LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99
- +9 NEW LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X
- +10 ;
- VET1 ; Code below executes to handle Patient episode.
- +1 ; Then, Howdy waits here for next Patient
- +2 ;
- +3 KILL LRCCOMX,LRDUX,LREDT,LRDX,DIK
- +4 KILL LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3
- +5 KILL LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT,LREXORD
- +6 KILL LRMERG,LRODRNUM,LRORDNUM,LRUNC,LRPARAM
- +7 KILL LRHYCT3,LRHYCTC,IOTLC,LRC,LRHYCT3,LRHYCTC,LRHYTOK,LRKIL,LRLABNOD
- +8 KILL LRLABSTP,LRLINE,LRLWC,LRN5,LRNONONO,LRNOT,LRNOTEST,LRNOUP,LRNT,LRNX0
- +9 KILL LRODRUM,LRONE,LRORDSIZ,LRORDT,LRORDT1,LRM1,LRM2,LRM3,LRPHONE,LRORIEN
- +10 KILL LRS,LRSC0,LRSDT,LRSN1,LRSPIEN,LRSSN,LRSTAR,LRSTOP,LRSTUCK
- +11 KILL LRT0,LRTECH,LRTKX,LRTM7,LRTOTAL,LRTST,LRTUBE,LRTXT,LRUDT,LRUNK,LRURG7
- +12 KILL LRURGA,LRURGNCY,LRURGT,LRURGZ19,LRX1,LRX2,LRX3,LRY1,LRYTAT,LR3,LR3MULT
- +13 KILL LR3NX0,LR3ODT,M9,V,LRHYORDZ
- +14 KILL LABCNT,LN,LR0NODE,LR68,LR6987,LR700,LR7LESS
- +15 KILL LR7MORE,LRAANAME,LRAAZ,LRAC1,LRACCER,LRACCTM,LRACCXX
- +16 KILL LRACNODE,LRACO,LRACTM,LRADD,LRBAR0,LRBAR1,LRBBRD
- +17 KILL LRBINGO,LRCEN,LRCNTX,LRCTYPE,LRD,LRDA,LRDRAW0
- +18 KILL LRDRAW1,LRDRAW7,LRDT,LRDTX,LRDUP,LRDUX,LREDT,LRDX
- +19 KILL LRFINX
- +20 ;
- +21 IF '$GET(LRDEV)
- DO PICK
- if LREND
- QUIT
- +22 ;
- +23 KILL LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD
- +24 KILL ^TMP("LRHYDY",$JOB)
- +25 ; Set Howdy up as Lab user
- DO ^LRPARAM
- +26 SET LRHOWDY=1
- +27 SET LRHYCT=$GET(LRHYCT,0)
- +28 IF LRHYCT=2
- WRITE !,"Please ask the clerk for assistance."
- KILL LRHYCT
- QUIT
- +29 SET LRODT=DT
- +30 WRITE @IOF
- +31 KILL X
- +32 ;
- +33 WRITE !!,"Please swipe your ID CARD or Type SSN: "
- +34 ; %ZOSF("EOFF") = U $I:NOECHO
- +35 ; %ZOSF("EON") = U $I:ECHO
- +36 XECUTE ^%ZOSF("EOFF")
- +37 READ X:9999999
- WRITE !
- +38 IF X=U
- XECUTE ^%ZOSF("EON")
- DO BAKUSER^LRHYU
- QUIT
- +39 XECUTE ^%ZOSF("EON")
- +40 ; Code is set to read all types of VIC card as of 9/05/2005
- +41 ;I $E(X,1,9)["-" D
- +42 ;. S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3)
- +43 ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10)
- +44 ;I $L(X)>10 S X=$E(X,2,10)
- +45 ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET
- +46 ;
- +47 KILL DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT
- +48 ;
- +49 ;S DFN=$O(^DPT("SSN",X,0))
- +50 ;
- +51 ; NEW CODE FOR VIC 4.0
- +52 DO RPCVIC^DPTLK(.DFN,X)
- +53 ;
- +54 IF DFN<1
- WRITE !,"No record for this person."
- READ X:15
- GOTO VET1
- +55 SET LRDFN=$GET(^DPT(DFN,"LR"))
- +56 ;
- +57 IF LRDFN
- DO PT^LRX
- +58 IF 'LRDFN
- WRITE !,"No Lab Data Available... Please check with clerk at the Desk."
- HANG 5
- DO LOG
- KILL X
- GOTO VET1
- +59 KILL ^TMP("LRHYDY",$JOB,"LRHYDY",$JOB,LRDFN)
- +60 ;
- +61 ; this call checks order against the 69.86
- +62 DO ORDCHK^LRHYB
- +63 ;
- +64 ;
- +65 ;
- +66 IF $GET(LRLOCS)
- WRITE !!!,"Please check with clerk at the Desk"
- HANG 5
- KILL X
- GOTO QUITH
- +67 IF $GET(LRMULT)
- WRITE !!!,"Please check with clerk at the Desk"
- HANG 5
- DO LOG
- KILL X
- GOTO QUITH
- +68 IF '$GET(LRORD)
- SET LREND=1
- WRITE !,$GET(LRCTYPE)," No Orders found. Please check with clerk at the Desk"
- HANG 5
- DO LOG
- KILL X
- GOTO QUITH
- +69 DO NOW^%DTC
- +70 ;
- +71 ;
- +72 ;
- PRT1 ;
- +1 ;
- +2 WRITE @IOF
- +3 DO SCRNON^LRHYUTL
- +4 SET PNMALL="Howdy "_$PIECE(PNM,",",2)_" "_$PIECE(PNM,",")
- +5 WRITE !
- +6 WRITE IODHLT," ",PNMALL
- +7 WRITE !
- +8 WRITE IODHLB," ",PNMALL
- +9 WRITE !
- +10 WRITE !,$$CJ^XLFSTR($GET(^LRHY(69.86,LRHYSITE,40)),IOM)
- +11 WRITE !,$$CJ^XLFSTR("Your Host is: "_$GET(^LRHY(69.86,LRHYSITE,42)),IOM)
- +12 WRITE !,$$CJ^XLFSTR($GET(^LRHY(69.86,LRHYSITE,44)),IOM)
- +13 WRITE !
- +14 WRITE IODHLT," Orders for date: "_$$Y2K^LRX(DT)
- +15 WRITE !
- +16 WRITE IODHLB," Orders for date: "_$$Y2K^LRX(DT)
- +17 WRITE !
- +18 SET LRXYZ=0
- +19 FOR
- SET LRXYZ=$ORDER(^LRHY(69.86,LRHYSITE,32,LRXYZ))
- if +LRXYZ'>0
- QUIT
- Begin DoDot:1
- +20 WRITE !
- +21 WRITE !,$$CJ^XLFSTR($GET(^LRHY(69.86,LRHYSITE,32,LRXYZ,0)),IOM)
- +22 WRITE !
- End DoDot:1
- +23 WRITE *7
- HANG 1
- WRITE *7
- HANG 1
- WRITE *7
- +24 ;
- +25 IF $DATA(^LRHY(69.86,7,54,"B"))
- DO BINBRD^LRHYBC1
- +26 HANG 5
- QUITH ;
- +1 ; Turn off screen variables
- DO SCRNOFF^LRHYUTL
- +2 KILL LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD,LRHYCT
- +3 KILL LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI
- +4 KILL LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND
- +5 KILL LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU
- +6 KILL LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN,LREXORD
- +7 KILL LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ
- +8 KILL LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT
- +9 KILL LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99
- +10 KILL LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X,LRLOCS
- +11 KILL VAIN
- +12 ;
- +13 ;
- +14 GOTO VET1
- +15 ;
- +16 ;
- +17 ;
- ORDCHK ; This block to be used for future version
- +1 QUIT
- LOG ; Howdy will default to the clerks judgement when multiple orders found.
- +1 IF $GET(LRMULT)
- QUIT
- +2 if $GET(LRSKIPNO)
- QUIT
- +3 ;
- +4 WRITE !,"NO ORDERS"
- +5 ;
- +6 KILL LRDPF,PNM
- +7 DO PT^LRX
- +8 DO NOW^%DTC
- +9 IF '$GET(LRDFN)
- SET ^TMP("LRHYDY",$JOB,"LR NO ORDERS",%)=$GET(DFN)
- QUIT
- +10 SET ^TMP("LRHYDY",$JOB,"LR NO ORDERS",%)=$GET(PNM)_U_$GET(^LR(LRDFN,.1))_U_$GET(SSN)
- +11 QUIT
- +12 ;
- +13 ;
- LOG1 ; Howdy will default to the clerks judgement when multiple orders found.
- +1 KILL LRORD,LRDPT,PNM
- +2 WRITE !,"MULTIPLE ORDERS"
- +3 KILL LRDPF,PNM
- +4 DO PT^LRX
- +5 DO NOW^%DTC
- +6 SET ^TMP("LRHYDY",$JOB,"LR MULTIPLE ORDERS",%)=$GET(PNM)_U_$GET(^LR(LRDFN,.1))_U_$GET(SSN)
- +7 SET LRSKIPNO=1
- +8 QUIT
- ORDERS ;
- +1 QUIT