BSDAPP ; IHS/ANMC/LJF - IHS CALLS FROM SDAPP ; [ 08/20/2004 11:51 AM ]
;;5.3;PIMS;**1001,1003,1004,1009**;MAY 28, 2004
;IHS/ITSC/LJF 06/15/2005 PATCH 1003 add ability to print future chart requests now
;IHS/OIT/LJF 07/28/2005 PATCH 1004 don't ask for printer if future date and printing in future
;cmi/anch/maw 02/21/2008 PATCH 1009 mods to print requirement 36
;cmi/anch/maw 02/21/2008 PATCH 1009 mods to print requirement 35
;
CR ;EP;Chart Request entry; called by SDAPP
; rewrote VA code to make it less confusing
;
NEW DIC,DIE,DA,DR,BSDV,BSDC,BSDCNT,BSDQ,DFN,BSDDT,X,Y,DLAYGO
S (DIC,DIE)="^SC(",DIC(0)="AQME",DIC("A")="SELECT CLINIC NAME: "
S DIC("W")=$$INACTMSG^BSDU
; screen: must be clinic, not out-of-service and have division set
S DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS"")),$P(^(0),U,15)]"""""
D ^DIC K DIC("A"),DIC("S") Q:+Y<0 S BSDC=+Y
;
; check out inactive status
S SDIN=$S($D(^SC(BSDC,"I")):1,1:""),SDRE=""
I SDIN S SDIN=+^SC(BSDC,"I"),SDRE=+$P(^("I"),"^",2)
I SDIN,SDIN'>DT,'SDRE S D0=+Y D WRT1^SDAPP Q
;
S BSDV=$$DELIVER Q:BSDV="" ;ask delivery info
;
; ask for date and stuff into clinic if not there yet
S BSDDT=$$READ^BDGF("DOA^"_DT_"::EX","Select Chart Delivery Date: ")
Q:'BSDDT
I '$D(^SC(BSDC,"C",BSDDT)) K DIC,DA D ;add date for clinic
. S DIC="^SC("_BSDC_",""C"",",DA(1)=BSDC,DIC(0)="L",DLAYGO=44.006
. S DIC("P")=$P(^DD(44,1906,0),U,2)
. S X=BSDDT D ^DIC
I '$D(^SC(BSDC,"C",BSDDT)) W !!,"Problem with this date for this clinic. Notify computer department." Q
;
;IHS/ITSC/LJF 06/15/2005 PATCH 1003
NEW BSDNOW K ^TMP("BSDNOW",$J)
S BSDNOW=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.14) I BSDNOW="" S BSDNOW="FUTURE"
;end of PATCH 1003 changes
;
; ask for patients and check against previous appt and chart requests
S (BSDQ,BSDCNT)=0 F Q:BSDQ=1 D
. S DFN=+$$READ^BDGF("PO^2:EMQZ","Select PATIENT") I DFN<1 S BSDQ=1 Q
. Q:'$$OKAY(DFN,BSDDT) ;show info to user and ask if okay
. K DIC,DIE,DA,DR
. S DIC="^SC("_BSDC_",""C"","_BSDDT_",1,",DIC(0)="L",DLAYGO=44.007
. S DIC("P")=$P(^DD(44.006,2,0),U,2)
. S DA(2)=BSDC,DA(1)=BSDDT,X=DFN
. D FILE^DICN
. I Y<1 W !!,"Problem recording chart request for patient. Contact computer department." Q
. ;
. I BSDNOW="NOW" S ^TMP("BSDNOW",$J,+Y)="" ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
. ;
. S DIE=DIC,DA=+Y
. S DR="9999999.01///^S X=$$NOW^XLFDT;9999999.02///^S X=""`""_DUZ;9999999.03///"_BSDV
. D ^DIE
. I '$G(Y) W !?5,"chart request recorded...",!!
. S BSDCNT=BSDCNT+1 ;increment count
;
I BSDNOW="FUTURE",BSDDT'=DT Q ;quit if future date and want to print in the future ;IHS/OIT/LJF 7/28/2005 PATCH 1004
; if at least one CR recorded, ask for printer
;I BSDCNT>0 W ! D PRINT(BSDC)
I BSDCNT>0 W ! D PRINT(BSDC,0,BSDDT,BSDNOW) ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
Q
;
;
OKAY(PAT,DATE) ; find other appts and chart requests for date
; if any found, ask user if they still want to request chart
NEW CLN,IEN,FIRST
S FIRST=1
;
; show if current inpatient
I $G(^DPT(PAT,.1))]"" D
. W !!,"** Current "
. NEW X S X=$$GET1^DIQ(2,PAT,.103)
. W $S(X["OBSERVATION":"Observation Patient",1:"Inpatient")
. W " on "_$G(^DPT(PAT,.1))_" ward **"
. S FIRST=0
;
; check for any chart requests
S CLN=0
F S CLN=$O(^SC("AIHSCR",PAT,CLN)) Q:'CLN D
. S IEN=0 F S IEN=$O(^SC("AIHSCR",PAT,CLN,DATE,IEN)) Q:'IEN D
.. I FIRST W !!,"Patient's chart already requested for:" S FIRST=0
.. W !?3,"Chart Request for ",$$GET1^DIQ(44,CLN,.01),?40,"made at "
.. W $$GET1^DIQ(44.007,IEN_","_DATE_","_CLN,9999999.01)
;
; now check for any appointments
S IEN=DATE
F S IEN=$O(^DPT(PAT,"S",IEN)) Q:'IEN Q:(IEN>(DATE+.24)) D
. I FIRST W !!,"Patient's chart already requested for:" S FIRST=0
. W !?3,"APPT at ",$$TIME^BDGF(IEN),?25,"for "
. W $$GET1^DIQ(44,+^DPT(PAT,"S",IEN,0),.01)
;
I FIRST Q 1 ;if nothing found, okay to proceed
;
Q +$$READ^BDGF("YO","Do you still want to request this chart","NO")
;
DELIVER() ; -- asks user for delivery info
NEW X,Y,DIR,DIRUT
;IHS/ITSC/WAR 5/20/04 P #1001 Change in verbage
;S DIR(0)="F^3:60",DIR("A")="DELIVER CHARTS TO (PROVIDER/LOCATION/EXT.)"
S DIR(0)="F^3:60",DIR("A")="REQUEST CHARTS FOR (PROVIDER/LOCATION/EXT.)"
D ^DIR I $D(DIRUT) S Y=""
I Y[";" S X(";")="-",Y=$$REPLACE^XLFSTR(Y,.X)
Q Y
;
;IHS/ITSC/LJF 06/15/2005 PATCH 1003 added 2 new parameters
PRINT(CLN,ADMIT,BSDDT,BSDNOW) ; set up print job for routing slips
; called by this routine after recording chart requests
; called by admission chart request ADMIT^BSDAPP
; CLN=chart request clinic
; ADMIT (optional), if set to 1, don't use default printer
;
;IHS/ITSC/LJF 06/15/2005 PATCH 1003
; BSDDT (optional), if set contains chart request date
; BSDNOW = NOW or FUTURE
;Q:'$D(^SC(CLN,"C",DT)) ;none for today; wait for add-ons
I $G(BSDNOW)'="NOW" Q:'$D(^SC(CLN,"C",DT))
;end of these PATCH 1003 changes
;
NEW VAUTC,SDATE,ORDER,SDX,SDREP,IEN,SDPARMS,DEV,DFN
S VAUTC=0,VAUTC(CLN)=$$GET1^DIQ(44,CLN,.01)
S SDATE=DT,ORDER=4,SDX="ALL",SDREP=""
;
S SDATE=$S($G(BSDDT):BSDDT,1:DT) ;IHS/ITSC/LJF 061/5/2005 PATCH 1003
;
S SDPARMS("DO NOT CLOSE")=1
;
; ask for print device, pull default from parameters
;IHS/ITSC/LJF 06/15/2005 PATCH 1003 use choice of default printers
;S DEV=$S($G(ADMIT)=1:"",1:$$GET1^DIQ(9009020.2,$$DIV^BSDU,.05))
S DEV=$S($G(ADMIT)=1:"",1:$$GET1^DIQ(9009020.2,$$DIV^BSDU,$S($G(BSDDT)=DT:.05,1:.21)))
;
I $D(DGQUIET),DEV="" Q
S %ZIS="N",%ZIS("A")="Chart Request Printer: "
;S:DEV]"" %ZIS("B")=DEV D ^%ZIS Q:POP ;cmi/maw 2/21/2008 PATCH 1009 requirement 35 orig line
DEVP S:DEV]"" %ZIS("B")=DEV D ^%ZIS
I POP W !,"Exiting out prevents, the remaining chart requests from printing, please select a device" G DEVP ;cmi/maw 2/21/2008 PATCH 1009 requirement 35
;cmi/maw 2/21/2008 PATCH 1009 requirement 36
I $G(IOS),$P($G(^%ZIS(1,IOS,0)),U,12)=2 D Q
. Q:$D(DGQUIET)
. W !,"You must select a device that allows queueing"
. H 2
;cmi/maw 2/21/2008 PATCH 1009 end of mods requirement 36
;
; find each patient and make separate call
NEW BDGQT I $D(DGQUIET) S BDGQT=1 ;was DGQUIET already set?
S DGQUIET=1,BSDDEV=ION
S IEN=0 F S IEN=$O(^SC(CLN,"C",SDATE,1,IEN)) Q:'IEN D
. Q:$P($G(^SC(CLN,"C",SDATE,1,IEN,9999999)),U,4)]"" ;already printed
. ;
. ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
. ; if printing future CRs now, was this one of your patient's
. I $G(BSDNOW)="NOW" Q:'$D(^TMP("BSDNOW",$J,IEN))
. ;
. S DFN=+$G(^SC(CLN,"C",SDATE,1,IEN,0)) Q:'DFN
. D WISD^BSDROUT(DFN,SDATE,"CR",BSDDEV)
D ^%ZISC
K BSDDEV
I '$D(BDGQT) K DGQUIET ;only kill if not set in previous call
K ^TMP("BSDNOW",$J) ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
Q
;
ADMIT(DFN,DGQUIET,BSDCLN,BSDDELV,BSDADT) ;EP; request chart at admission
; Called by ADT Event Driver protocol
; DGQUIET = if set to 1, no user interaction
; BSDCLN = if set, ien to clinic
; BSDDELV = if set, delivery message (who, where, phone)
; BSDADT = ien of admission in file 405
; ** I $G(DGQUIET) then Chart Request Printer must be set in
; IHS Scheduling Parameter file
;
; quit if parameter not turned on
NEW DIV
S DIV=$$DIV^BDGPAR(DUZ(2)) Q:'DIV
Q:$$GET1^DIQ(9009020.1,DIV,.09)'="YES"
;
; first get chart request clinic
I '$G(BSDCLN) D Q:$G(BSDCLN)<1
. ; if not sent and in quiet mode, get clinic from parameter file
. I $G(DGQUIET) S BSDCLN=$$GET1^DIQ(9009020.1,DIV,.11,"I") Q
. ;
. ; else, ask for clinic with parameter file entry as default
. W !!,"Requesting Chart for new admission. Type ^ to bypass."
. K DIC S DIC="^SC(",DIC(0)="AEQM",DIC("W")=$$INACTMSG^BSDU
. S DIC("B")=$$GET1^DIQ(9009020.1,DIV,.11) ;default
. S DIC("S")="I $P(^(0),U,3)=""C"""
. S DIC("A")="Select Clinic Name: "
. D ^DIC K DIC S BSDCLN=+Y
;
; next find out to whom it is to be delivered
I $G(BSDDELV)="" D Q:$G(BSDDELV)=""
. ; if not sent and in quiet mode, use user name & office phone
. I $G(DGQUIET) S BSDDELV="New Admission - Deliver Chart to "_$$GET1^DIQ(405,+$G(BSDADT),.06)_" Ward" Q
. ;
. ; else ask user
. S BSDDELV=$$DELIVER^BSDAPP ;see subrtn above for details
;
; next stuff chart request into file (code from ^SDAPP)
NEW DIC,X,DLAYGO,DINUM,DD,DO,Y,DIE,DA,DR
;
; add today's date if not there
I '$D(^SC(BSDCLN,"C",DT,0)) D Q:Y<1
. S DIC="^SC("_BSDCLN_",""C"",",X=DT,DIC(0)="L",DLAYGO=44.006
. S DIC("P")="44.006DA",DINUM=DT,DA(1)=BSDCLN
. L +^SC(BSDCLN,"C"):3 I '$T S Y=0 Q
. K DD,DO D FILE^DICN L -^SC(BSDCLN,"C")
. I Y<1 W:'$D(DGQUIET) !,"Error filing chart request!!!"
;
; now add patient to today's list
S DIC="^SC("_BSDCLN_",""C"","_DT_",1,",DIC(0)="L",DLAYGO=44.007
S DIC("P")="44.007PA",X=DFN,DA(2)=BSDCLN,DA(1)=DT
L +^SC(BSDCLN,"C",DT):3 I '$T S Y=0 Q
K DD,DO D FILE^DICN L -^SC(BSDCLN,"C",DT)
I Y<1 W:'$D(DGQUIET) !,"Error filing chart request!!!" Q
;
; add other data items
S DIE="^SC("_BSDCLN_",""C"","_DT_",1,"
S DA=+Y,DA(1)=DT,DA(2)=BSDCLN
S DR="9999999.01///"_$$NOW^XLFDT_";9999999.02///"_DUZ
S DR=DR_";9999999.03///"_BSDDELV
D ^DIE
;
; now print request
D PRINT^BSDAPP(BSDCLN,1)
Q
;
BSDAPP ; IHS/ANMC/LJF - IHS CALLS FROM SDAPP ; [ 08/20/2004 11:51 AM ]
+1 ;;5.3;PIMS;**1001,1003,1004,1009**;MAY 28, 2004
+2 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003 add ability to print future chart requests now
+3 ;IHS/OIT/LJF 07/28/2005 PATCH 1004 don't ask for printer if future date and printing in future
+4 ;cmi/anch/maw 02/21/2008 PATCH 1009 mods to print requirement 36
+5 ;cmi/anch/maw 02/21/2008 PATCH 1009 mods to print requirement 35
+6 ;
CR ;EP;Chart Request entry; called by SDAPP
+1 ; rewrote VA code to make it less confusing
+2 ;
+3 NEW DIC,DIE,DA,DR,BSDV,BSDC,BSDCNT,BSDQ,DFN,BSDDT,X,Y,DLAYGO
+4 SET (DIC,DIE)="^SC("
SET DIC(0)="AQME"
SET DIC("A")="SELECT CLINIC NAME: "
+5 SET DIC("W")=$$INACTMSG^BSDU
+6 ; screen: must be clinic, not out-of-service and have division set
+7 SET DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS"")),$P(^(0),U,15)]"""""
+8 DO ^DIC
KILL DIC("A"),DIC("S")
IF +Y<0
QUIT
SET BSDC=+Y
+9 ;
+10 ; check out inactive status
+11 SET SDIN=$SELECT($DATA(^SC(BSDC,"I")):1,1:"")
SET SDRE=""
+12 IF SDIN
SET SDIN=+^SC(BSDC,"I")
SET SDRE=+$PIECE(^("I"),"^",2)
+13 IF SDIN
IF SDIN'>DT
IF 'SDRE
SET D0=+Y
DO WRT1^SDAPP
QUIT
+14 ;
+15 ;ask delivery info
SET BSDV=$$DELIVER
IF BSDV=""
QUIT
+16 ;
+17 ; ask for date and stuff into clinic if not there yet
+18 SET BSDDT=$$READ^BDGF("DOA^"_DT_"::EX","Select Chart Delivery Date: ")
+19 IF 'BSDDT
QUIT
+20 ;add date for clinic
IF '$DATA(^SC(BSDC,"C",BSDDT))
KILL DIC,DA
Begin DoDot:1
+21 SET DIC="^SC("_BSDC_",""C"","
SET DA(1)=BSDC
SET DIC(0)="L"
SET DLAYGO=44.006
+22 SET DIC("P")=$PIECE(^DD(44,1906,0),U,2)
+23 SET X=BSDDT
DO ^DIC
End DoDot:1
+24 IF '$DATA(^SC(BSDC,"C",BSDDT))
WRITE !!,"Problem with this date for this clinic. Notify computer department."
QUIT
+25 ;
+26 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
+27 NEW BSDNOW
KILL ^TMP("BSDNOW",$JOB)
+28 SET BSDNOW=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.14)
IF BSDNOW=""
SET BSDNOW="FUTURE"
+29 ;end of PATCH 1003 changes
+30 ;
+31 ; ask for patients and check against previous appt and chart requests
+32 SET (BSDQ,BSDCNT)=0
FOR
IF BSDQ=1
QUIT
Begin DoDot:1
+33 SET DFN=+$$READ^BDGF("PO^2:EMQZ","Select PATIENT")
IF DFN<1
SET BSDQ=1
QUIT
+34 ;show info to user and ask if okay
IF '$$OKAY(DFN,BSDDT)
QUIT
+35 KILL DIC,DIE,DA,DR
+36 SET DIC="^SC("_BSDC_",""C"","_BSDDT_",1,"
SET DIC(0)="L"
SET DLAYGO=44.007
+37 SET DIC("P")=$PIECE(^DD(44.006,2,0),U,2)
+38 SET DA(2)=BSDC
SET DA(1)=BSDDT
SET X=DFN
+39 DO FILE^DICN
+40 IF Y<1
WRITE !!,"Problem recording chart request for patient. Contact computer department."
QUIT
+41 ;
+42 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
IF BSDNOW="NOW"
SET ^TMP("BSDNOW",$JOB,+Y)=""
+43 ;
+44 SET DIE=DIC
SET DA=+Y
+45 SET DR="9999999.01///^S X=$$NOW^XLFDT;9999999.02///^S X=""`""_DUZ;9999999.03///"_BSDV
+46 DO ^DIE
+47 IF '$GET(Y)
WRITE !?5,"chart request recorded...",!!
+48 ;increment count
SET BSDCNT=BSDCNT+1
End DoDot:1
+49 ;
+50 ;quit if future date and want to print in the future ;IHS/OIT/LJF 7/28/2005 PATCH 1004
IF BSDNOW="FUTURE"
IF BSDDT'=DT
QUIT
+51 ; if at least one CR recorded, ask for printer
+52 ;I BSDCNT>0 W ! D PRINT(BSDC)
+53 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
IF BSDCNT>0
WRITE !
DO PRINT(BSDC,0,BSDDT,BSDNOW)
+54 QUIT
+55 ;
+56 ;
OKAY(PAT,DATE) ; find other appts and chart requests for date
+1 ; if any found, ask user if they still want to request chart
+2 NEW CLN,IEN,FIRST
+3 SET FIRST=1
+4 ;
+5 ; show if current inpatient
+6 IF $GET(^DPT(PAT,.1))]""
Begin DoDot:1
+7 WRITE !!,"** Current "
+8 NEW X
SET X=$$GET1^DIQ(2,PAT,.103)
+9 WRITE $SELECT(X["OBSERVATION":"Observation Patient",1:"Inpatient")
+10 WRITE " on "_$GET(^DPT(PAT,.1))_" ward **"
+11 SET FIRST=0
End DoDot:1
+12 ;
+13 ; check for any chart requests
+14 SET CLN=0
+15 FOR
SET CLN=$ORDER(^SC("AIHSCR",PAT,CLN))
IF 'CLN
QUIT
Begin DoDot:1
+16 SET IEN=0
FOR
SET IEN=$ORDER(^SC("AIHSCR",PAT,CLN,DATE,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+17 IF FIRST
WRITE !!,"Patient's chart already requested for:"
SET FIRST=0
+18 WRITE !?3,"Chart Request for ",$$GET1^DIQ(44,CLN,.01),?40,"made at "
+19 WRITE $$GET1^DIQ(44.007,IEN_","_DATE_","_CLN,9999999.01)
End DoDot:2
End DoDot:1
+20 ;
+21 ; now check for any appointments
+22 SET IEN=DATE
+23 FOR
SET IEN=$ORDER(^DPT(PAT,"S",IEN))
IF 'IEN
QUIT
IF (IEN>(DATE+.24))
QUIT
Begin DoDot:1
+24 IF FIRST
WRITE !!,"Patient's chart already requested for:"
SET FIRST=0
+25 WRITE !?3,"APPT at ",$$TIME^BDGF(IEN),?25,"for "
+26 WRITE $$GET1^DIQ(44,+^DPT(PAT,"S",IEN,0),.01)
End DoDot:1
+27 ;
+28 ;if nothing found, okay to proceed
IF FIRST
QUIT 1
+29 ;
+30 QUIT +$$READ^BDGF("YO","Do you still want to request this chart","NO")
+31 ;
DELIVER() ; -- asks user for delivery info
+1 NEW X,Y,DIR,DIRUT
+2 ;IHS/ITSC/WAR 5/20/04 P #1001 Change in verbage
+3 ;S DIR(0)="F^3:60",DIR("A")="DELIVER CHARTS TO (PROVIDER/LOCATION/EXT.)"
+4 SET DIR(0)="F^3:60"
SET DIR("A")="REQUEST CHARTS FOR (PROVIDER/LOCATION/EXT.)"
+5 DO ^DIR
IF $DATA(DIRUT)
SET Y=""
+6 IF Y[";"
SET X(";")="-"
SET Y=$$REPLACE^XLFSTR(Y,.X)
+7 QUIT Y
+8 ;
+9 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003 added 2 new parameters
PRINT(CLN,ADMIT,BSDDT,BSDNOW) ; set up print job for routing slips
+1 ; called by this routine after recording chart requests
+2 ; called by admission chart request ADMIT^BSDAPP
+3 ; CLN=chart request clinic
+4 ; ADMIT (optional), if set to 1, don't use default printer
+5 ;
+6 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
+7 ; BSDDT (optional), if set contains chart request date
+8 ; BSDNOW = NOW or FUTURE
+9 ;Q:'$D(^SC(CLN,"C",DT)) ;none for today; wait for add-ons
+10 IF $GET(BSDNOW)'="NOW"
IF '$DATA(^SC(CLN,"C",DT))
QUIT
+11 ;end of these PATCH 1003 changes
+12 ;
+13 NEW VAUTC,SDATE,ORDER,SDX,SDREP,IEN,SDPARMS,DEV,DFN
+14 SET VAUTC=0
SET VAUTC(CLN)=$$GET1^DIQ(44,CLN,.01)
+15 SET SDATE=DT
SET ORDER=4
SET SDX="ALL"
SET SDREP=""
+16 ;
+17 ;IHS/ITSC/LJF 061/5/2005 PATCH 1003
SET SDATE=$SELECT($GET(BSDDT):BSDDT,1:DT)
+18 ;
+19 SET SDPARMS("DO NOT CLOSE")=1
+20 ;
+21 ; ask for print device, pull default from parameters
+22 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003 use choice of default printers
+23 ;S DEV=$S($G(ADMIT)=1:"",1:$$GET1^DIQ(9009020.2,$$DIV^BSDU,.05))
+24 SET DEV=$SELECT($GET(ADMIT)=1:"",1:$$GET1^DIQ(9009020.2,$$DIV^BSDU,$SELECT($GET(BSDDT)=DT:.05,1:.21)))
+25 ;
+26 IF $DATA(DGQUIET)
IF DEV=""
QUIT
+27 SET %ZIS="N"
SET %ZIS("A")="Chart Request Printer: "
+28 ;S:DEV]"" %ZIS("B")=DEV D ^%ZIS Q:POP ;cmi/maw 2/21/2008 PATCH 1009 requirement 35 orig line
DEVP IF DEV]""
SET %ZIS("B")=DEV
DO ^%ZIS
+1 ;cmi/maw 2/21/2008 PATCH 1009 requirement 35
IF POP
WRITE !,"Exiting out prevents, the remaining chart requests from printing, please select a device"
GOTO DEVP
+2 ;cmi/maw 2/21/2008 PATCH 1009 requirement 36
+3 IF $GET(IOS)
IF $PIECE($GET(^%ZIS(1,IOS,0)),U,12)=2
Begin DoDot:1
+4 IF $DATA(DGQUIET)
QUIT
+5 WRITE !,"You must select a device that allows queueing"
+6 HANG 2
End DoDot:1
QUIT
+7 ;cmi/maw 2/21/2008 PATCH 1009 end of mods requirement 36
+8 ;
+9 ; find each patient and make separate call
+10 ;was DGQUIET already set?
NEW BDGQT
IF $DATA(DGQUIET)
SET BDGQT=1
+11 SET DGQUIET=1
SET BSDDEV=ION
+12 SET IEN=0
FOR
SET IEN=$ORDER(^SC(CLN,"C",SDATE,1,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+13 ;already printed
IF $PIECE($GET(^SC(CLN,"C",SDATE,1,IEN,9999999)),U,4)]""
QUIT
+14 ;
+15 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
+16 ; if printing future CRs now, was this one of your patient's
+17 IF $GET(BSDNOW)="NOW"
IF '$DATA(^TMP("BSDNOW",$JOB,IEN))
QUIT
+18 ;
+19 SET DFN=+$GET(^SC(CLN,"C",SDATE,1,IEN,0))
IF 'DFN
QUIT
+20 DO WISD^BSDROUT(DFN,SDATE,"CR",BSDDEV)
End DoDot:1
+21 DO ^%ZISC
+22 KILL BSDDEV
+23 ;only kill if not set in previous call
IF '$DATA(BDGQT)
KILL DGQUIET
+24 ;IHS/ITSC/LJF 06/15/2005 PATCH 1003
KILL ^TMP("BSDNOW",$JOB)
+25 QUIT
+26 ;
ADMIT(DFN,DGQUIET,BSDCLN,BSDDELV,BSDADT) ;EP; request chart at admission
+1 ; Called by ADT Event Driver protocol
+2 ; DGQUIET = if set to 1, no user interaction
+3 ; BSDCLN = if set, ien to clinic
+4 ; BSDDELV = if set, delivery message (who, where, phone)
+5 ; BSDADT = ien of admission in file 405
+6 ; ** I $G(DGQUIET) then Chart Request Printer must be set in
+7 ; IHS Scheduling Parameter file
+8 ;
+9 ; quit if parameter not turned on
+10 NEW DIV
+11 SET DIV=$$DIV^BDGPAR(DUZ(2))
IF 'DIV
QUIT
+12 IF $$GET1^DIQ(9009020.1,DIV,.09)'="YES"
QUIT
+13 ;
+14 ; first get chart request clinic
+15 IF '$GET(BSDCLN)
Begin DoDot:1
+16 ; if not sent and in quiet mode, get clinic from parameter file
+17 IF $GET(DGQUIET)
SET BSDCLN=$$GET1^DIQ(9009020.1,DIV,.11,"I")
QUIT
+18 ;
+19 ; else, ask for clinic with parameter file entry as default
+20 WRITE !!,"Requesting Chart for new admission. Type ^ to bypass."
+21 KILL DIC
SET DIC="^SC("
SET DIC(0)="AEQM"
SET DIC("W")=$$INACTMSG^BSDU
+22 ;default
SET DIC("B")=$$GET1^DIQ(9009020.1,DIV,.11)
+23 SET DIC("S")="I $P(^(0),U,3)=""C"""
+24 SET DIC("A")="Select Clinic Name: "
+25 DO ^DIC
KILL DIC
SET BSDCLN=+Y
End DoDot:1
IF $GET(BSDCLN)<1
QUIT
+26 ;
+27 ; next find out to whom it is to be delivered
+28 IF $GET(BSDDELV)=""
Begin DoDot:1
+29 ; if not sent and in quiet mode, use user name & office phone
+30 IF $GET(DGQUIET)
SET BSDDELV="New Admission - Deliver Chart to "_$$GET1^DIQ(405,+$GET(BSDADT),.06)_" Ward"
QUIT
+31 ;
+32 ; else ask user
+33 ;see subrtn above for details
SET BSDDELV=$$DELIVER^BSDAPP
End DoDot:1
IF $GET(BSDDELV)=""
QUIT
+34 ;
+35 ; next stuff chart request into file (code from ^SDAPP)
+36 NEW DIC,X,DLAYGO,DINUM,DD,DO,Y,DIE,DA,DR
+37 ;
+38 ; add today's date if not there
+39 IF '$DATA(^SC(BSDCLN,"C",DT,0))
Begin DoDot:1
+40 SET DIC="^SC("_BSDCLN_",""C"","
SET X=DT
SET DIC(0)="L"
SET DLAYGO=44.006
+41 SET DIC("P")="44.006DA"
SET DINUM=DT
SET DA(1)=BSDCLN
+42 LOCK +^SC(BSDCLN,"C"):3
IF '$TEST
SET Y=0
QUIT
+43 KILL DD,DO
DO FILE^DICN
LOCK -^SC(BSDCLN,"C")
+44 IF Y<1
IF '$DATA(DGQUIET)
WRITE !,"Error filing chart request!!!"
End DoDot:1
IF Y<1
QUIT
+45 ;
+46 ; now add patient to today's list
+47 SET DIC="^SC("_BSDCLN_",""C"","_DT_",1,"
SET DIC(0)="L"
SET DLAYGO=44.007
+48 SET DIC("P")="44.007PA"
SET X=DFN
SET DA(2)=BSDCLN
SET DA(1)=DT
+49 LOCK +^SC(BSDCLN,"C",DT):3
IF '$TEST
SET Y=0
QUIT
+50 KILL DD,DO
DO FILE^DICN
LOCK -^SC(BSDCLN,"C",DT)
+51 IF Y<1
IF '$DATA(DGQUIET)
WRITE !,"Error filing chart request!!!"
QUIT
+52 ;
+53 ; add other data items
+54 SET DIE="^SC("_BSDCLN_",""C"","_DT_",1,"
+55 SET DA=+Y
SET DA(1)=DT
SET DA(2)=BSDCLN
+56 SET DR="9999999.01///"_$$NOW^XLFDT_";9999999.02///"_DUZ
+57 SET DR=DR_";9999999.03///"_BSDDELV
+58 DO ^DIE
+59 ;
+60 ; now print request
+61 DO PRINT^BSDAPP(BSDCLN,1)
+62 QUIT
+63 ;
