ASDI ; IHS/ADC/PDW/ENM - CHECK-IN/UNSCH APPT/CR TODAY ; [ 12/01/2000 10:49 AM ]
;;5.0;IHS SCHEDULING;**5,7**;MAR 25, 1999
;PATCH 5: saved old check-in date/time if changed
;PATCH 7: ask to change check-in time if only one appt in list
;
PAT ; -- select patient
Q:$G(SDPEP)
K ASDCR,SDZPL S (DFN,DIV)="" D PAT^ASDM I 'DFN!($D(ASDQUIT)) D END Q
PAT2 ;PEP; called when patient already known
; calling routine must set DFN=patient ien, SDPEP=1,DIV=""
; calling routine must kill SDPEP and pre-save DFN value
D APPT ; displays today's appts
D WARD^ASDM ; display if inpt
;
CHOOSE ; -- ask what user wants to do
S SDSEX=AUPNSEX="F"
W !! K DIR S DIR(0)="NO^1:3"
S DIR("A",1)=" 1. ADD NEW UNSCHEDULED APPOINTMENT (WALK-IN)"
S DIR("A",2)=" 2. CHECK-IN PATIENT FOR SCHEDULED APPOINTMENT"
S DIR("A",3)=" 3. REQUEST CHART FOR REVIEW"
S DIR("A")="Choose Action" D ^DIR I $D(DIRUT) G ASDI
I Y=2 D CHK G PAT
I Y=3 D CR G PAT
W ! D NEW^SDI G PAT
;
;
END ; -- eoj
D END^SDI K ASDCT,ASDS,ASDE,ASDA,DIR,ASDQUIT,HRCN,DFN,SEX,AGE,SSN
Q
;
CHK ; -- SUBRTN to check patient in for appt
NEW X
I '$D(ASDA) W !!,"NO SCHEDULED APPOINTMENTS; CANNOT CHECK IN" Q
S X=$O(ASDA(0))
I '$O(ASDA(X)) D Q
. S SDPR=+ASDA(X),I(SDPR)=$P(ASDA(X),U,3) ;PATCH 7
. I $P(ASDA(X),U,2)=1 S ASDCKO=$P(ASDA(X),U,4) G CHK2 ;PATCH 7
. ;S ASDCKO=$P(ASDA(X),U,4) ;PATCH 5 ;PATCH 7
. ;S SDPR=+ASDA(X),I(SDPR)=$P(ASDA(X),U,3),I=$$SCX D GOT^SDI ;PATCH 7
. S I=$$SCX D GOT^SDI
;
D APPT
K DIR S DIR(0)="NO^1:"_ASDCT,DIR("A")="Which APPOINTMENT"
D ^DIR Q:$D(DIRUT) Q:Y<1
S SDPR=+ASDA(Y),I(SDPR)=$P(ASDA(Y),U,3)
I $P(ASDA(Y),U,2)=0 S I=$$SCX D GOT^SDI Q
S ASDCKO=$P(ASDA(X),U,4) ;PATCH 5
;
CHK2 ;PATCH 7
S ASD=Y K DIR S DIR(0)="YO",DIR("B")="NO"
S DIR("A")="PATIENT ALREADY CHECKED IN; WANT TO UPDATE CHECK-IN TIME"
D ^DIR I Y=1 S I=$$SCX D GOT^SDI Q
;
G CHK
;
;
CR ; -- SUBRTN to request chart
K DIC S DIC=44,DIC(0)="AEMQ"
S DIC("A")="REQUEST CHART FOR WHICH CLINIC: "
S DIC("S")="I $P(^(0),U,3)=""C"",$D(^(""SL""))"
D ^DIC K DIC Q:X[U!(Y<0)
S SC=+Y,YY=Y,SDSL=$S($D(^SC(SC,"SL")):+^("SL"),1:"") K SDRE,SDIN,SDRE1
;
I $D(^SC(SC,"I")) D
. S SDIN=+^SC(SC,"I"),SDRE=+$P(^("I"),U,2),Y=SDRE D DTS^SDUTL S SDRE1=Y
;
I $S('$D(SDIN):0,'SDIN:0,SDIN>DT:0,SDRE'>DT&(SDRE):0,1:1) D G CR
. W !,*7,"Clinic is inactive ",$S(SDRE:"from ",1:"as of ")
. S Y=SDIN D DTS^SDUTL W Y,$S(SDRE:" to "_SDRE1,1:"")
;
K DIR S DIR(0)="D^::EXR",DIR("B")="NOW"
S DIR("A")="REQUEST DATE/TIME:" D ^DIR Q:$D(DIRUT) Q:Y=-1
D OKTD^SDI
Q
;
;
APPT ; -- SUBRTN to display today's appointments
K ASDCT,ASDS,ASDE,ASDA
;
S ASDS=DT-.0001,ASDE=DT+.2400
S X=$O(^DPT(DFN,"S",ASDS)) I 'X!(X>ASDE) D Q
. W !!?5,"** NO PENDING APPOINTMENTS FOR TODAY **",!
;
W !!?20,"**** TODAY'S APPOINTMENTS ****"
F S ASDS=$O(^DPT(DFN,"S",ASDS)) Q:'ASDS!(ASDS>ASDE) D
. I "I"[$P(^DPT(DFN,"S",ASDS,0),U,2) D
.. S ASDCT=$G(ASDCT)+1
.. S Y=ASDS D CHKSO^SDM W:$X>9 !,ASDCT W ?11 D DT^SDM0 W ?32 S DA=+SSC
.. W SDLN,$S($D(^SC(DA,0)):$P(^(0),U),1:"DELETED CLINIC ")
.. W COV," "
.. I $P(^DPT(DFN,"S",ASDS,0),U,7)=4 D Q
... ;W "UNSCHEDULED" S ASDA(ASDCT)=ASDS_U_1_U_+SSC ;PATCH 5
... W "UNSCHEDULED" S ASDA(ASDCT)=ASDS_U_1_U_+SSC_U_$$CHECKIN ;PATCH 5
.. I $P(^DPT(DFN,"S",ASDS,0),U,7)=3 D K ASDCKI
... S ASDCKI=$$CHECKIN I ASDCKI="" S ASDA(ASDCT)=ASDS_U_0_U_+SSC Q
... W !?15,"CHECKED-IN at " S Y=ASDCKI D DT^SDM0
... ;S ASDA(ASDCT)=ASDS_U_1_U_+SSC ;PATCH 5
... S ASDA(ASDCT)=ASDS_U_1_U_+SSC_U_ASDCKI ;PATCH 5
Q
;
CHKR ;EP; called by CHKR to print IHS forms
NEW DIR S DIR(0)="YO",DIR("B")="YES"
S DIR("A")="WANT TO PRINT ROUTING SLIP NOW" D ^DIR Q:Y<1 S SDZRS=Y
K IOP S (SDX,SDSTART,ORDER,SDREP,SDZCV)=""
S (SDZEF,SDZHS,SDZMP,SDZAI)=1 D FORMS
S SDZSC=SC,SDZDFN=DFN I SDZRS=1 D EN^SDROUT1
I $P($G(^DG(40.8,$$DIV^ASDUT,"IHS")),U,4)'=1 D HS
K SDZCV,SDZHS,SDZEF,SDZMP,SDZAI,SDZSC,SDZRS,SDZDFN
Q
;
FORMS ; -- checks if forms to be printed
Q:$P($G(^DG(40.8,$$DIV^ASDUT,"IHS")),U,4)'=1
FORMS1 ;
I $P($G(^SC(SC,9999999)),U)="Y",$$HSTYP^ASDUT(SC,DFN)]"" S SDZHS=0_U_$$HSTYP^ASDUT(SC,DFN)
I $P($G(^SC(SC,9999999)),U,5)="Y" S SDZEF=0
I $P($G(^SC(SC,9999999)),U,3)="Y" S SDZMP=0
I $P($G(^SC(SC,9999999)),U,4)="Y" S SDZAI=0
Q
;
HS ; -- prints HS and other forms if set to YES for clinic
NEW SC,DFN
S SC=SDZSC,DFN=SDZDFN
I $P($G(^SC(SC,9999999)),U,1)'="Y" Q
S (SDZEF,SDZHS,SDZMP,SDZAI)=1 D FORMS1
I (SDZEF=1),(+SDZHS=1),(SDZMP=1),(SDZAI=1) Q
I $$DFWI="" D Q:POP
. W !!,"Ready to print Health Summary now . . "
. S %ZIS="" D ^%ZIS
S ZTIO=$S($$DFWI]"":$$DFWI,1:ION)
S ZTRTN="HS1^ASDI",ZTDESC="HS & OTHER FORMS",ZTDTH=$H
F I="DFN","SDZEF","SDZHS","SDZMP","SDZAI","SDZSC","SDPR" S ZTSAVE(I)=""
D ^%ZTLOAD K ZTSK D HOME^%ZIS Q
;
HS1 ;EP; called by ZTLOAD to print forms
U IO
I SDZEF=0 D EF^ASDFORM(SDZSC,DFN,SDPR)
I +SDZHS=0 D HS^ASDFORM(DFN,$P(SDZHS,U,2))
I SDZMP=0 D MP^ASDFORM(DFN)
I SDZAI=0 D AIU^ASDFORM(DFN)
D ^%ZISC
Q
;
DFWI() ; -- returns default health summary printer
Q $$VAL^XBDIQ1(40.8,$$DIV^ASDUT,9999999.06)
;
CHECKIN() ; -- returns check-in time
NEW X,Y,QUIT,CLN
S CLN=$$CLN
S X=0 F S X=$O(^SC(CLN,"S",ASDS,1,X)) Q:'X!($D(QUIT)) D
. Q:$P(^SC(CLN,"S",ASDS,1,X,0),U)'=DFN
. S Y=$G(^SC(CLN,"S",ASDS,1,X,"C")) I Y]"" S QUIT=""
Q $G(Y)
;
SCX() ; -- returns multiple ien for patient in ^sc
NEW X
S X=0
F S X=$O(^SC(I(SDPR),"S",SDPR,1,X)) Q:'X Q:(+^(X,0)=DFN)
Q X
;
CLN() ; -- returns clinic ien
Q $P(^DPT(DFN,"S",ASDS,0),U)
;
ASDI ; IHS/ADC/PDW/ENM - CHECK-IN/UNSCH APPT/CR TODAY ; [ 12/01/2000 10:49 AM ]
+1 ;;5.0;IHS SCHEDULING;**5,7**;MAR 25, 1999
+2 ;PATCH 5: saved old check-in date/time if changed
+3 ;PATCH 7: ask to change check-in time if only one appt in list
+4 ;
PAT ; -- select patient
+1 IF $GET(SDPEP)
QUIT
+2 KILL ASDCR,SDZPL
SET (DFN,DIV)=""
DO PAT^ASDM
IF 'DFN!($DATA(ASDQUIT))
DO END
QUIT
PAT2 ;PEP; called when patient already known
+1 ; calling routine must set DFN=patient ien, SDPEP=1,DIV=""
+2 ; calling routine must kill SDPEP and pre-save DFN value
+3 ; displays today's appts
DO APPT
+4 ; display if inpt
DO WARD^ASDM
+5 ;
CHOOSE ; -- ask what user wants to do
+1 SET SDSEX=AUPNSEX="F"
+2 WRITE !!
KILL DIR
SET DIR(0)="NO^1:3"
+3 SET DIR("A",1)=" 1. ADD NEW UNSCHEDULED APPOINTMENT (WALK-IN)"
+4 SET DIR("A",2)=" 2. CHECK-IN PATIENT FOR SCHEDULED APPOINTMENT"
+5 SET DIR("A",3)=" 3. REQUEST CHART FOR REVIEW"
+6 SET DIR("A")="Choose Action"
DO ^DIR
IF $DATA(DIRUT)
GOTO ASDI
+7 IF Y=2
DO CHK
GOTO PAT
+8 IF Y=3
DO CR
GOTO PAT
+9 WRITE !
DO NEW^SDI
GOTO PAT
+10 ;
+11 ;
END ; -- eoj
+1 DO END^SDI
KILL ASDCT,ASDS,ASDE,ASDA,DIR,ASDQUIT,HRCN,DFN,SEX,AGE,SSN
+2 QUIT
+3 ;
CHK ; -- SUBRTN to check patient in for appt
+1 NEW X
+2 IF '$DATA(ASDA)
WRITE !!,"NO SCHEDULED APPOINTMENTS; CANNOT CHECK IN"
QUIT
+3 SET X=$ORDER(ASDA(0))
+4 IF '$ORDER(ASDA(X))
Begin DoDot:1
+5 ;PATCH 7
SET SDPR=+ASDA(X)
SET I(SDPR)=$PIECE(ASDA(X),U,3)
+6 ;PATCH 7
IF $PIECE(ASDA(X),U,2)=1
SET ASDCKO=$PIECE(ASDA(X),U,4)
GOTO CHK2
+7 ;S ASDCKO=$P(ASDA(X),U,4) ;PATCH 5 ;PATCH 7
+8 ;S SDPR=+ASDA(X),I(SDPR)=$P(ASDA(X),U,3),I=$$SCX D GOT^SDI ;PATCH 7
+9 SET I=$$SCX
DO GOT^SDI
End DoDot:1
QUIT
+10 ;
+11 DO APPT
+12 KILL DIR
SET DIR(0)="NO^1:"_ASDCT
SET DIR("A")="Which APPOINTMENT"
+13 DO ^DIR
IF $DATA(DIRUT)
QUIT
IF Y<1
QUIT
+14 SET SDPR=+ASDA(Y)
SET I(SDPR)=$PIECE(ASDA(Y),U,3)
+15 IF $PIECE(ASDA(Y),U,2)=0
SET I=$$SCX
DO GOT^SDI
QUIT
+16 ;PATCH 5
SET ASDCKO=$PIECE(ASDA(X),U,4)
+17 ;
CHK2 ;PATCH 7
+1 SET ASD=Y
KILL DIR
SET DIR(0)="YO"
SET DIR("B")="NO"
+2 SET DIR("A")="PATIENT ALREADY CHECKED IN; WANT TO UPDATE CHECK-IN TIME"
+3 DO ^DIR
IF Y=1
SET I=$$SCX
DO GOT^SDI
QUIT
+4 ;
+5 GOTO CHK
+6 ;
+7 ;
CR ; -- SUBRTN to request chart
+1 KILL DIC
SET DIC=44
SET DIC(0)="AEMQ"
+2 SET DIC("A")="REQUEST CHART FOR WHICH CLINIC: "
+3 SET DIC("S")="I $P(^(0),U,3)=""C"",$D(^(""SL""))"
+4 DO ^DIC
KILL DIC
IF X[U!(Y<0)
QUIT
+5 SET SC=+Y
SET YY=Y
SET SDSL=$SELECT($DATA(^SC(SC,"SL")):+^("SL"),1:"")
KILL SDRE,SDIN,SDRE1
+6 ;
+7 IF $DATA(^SC(SC,"I"))
Begin DoDot:1
+8 SET SDIN=+^SC(SC,"I")
SET SDRE=+$PIECE(^("I"),U,2)
SET Y=SDRE
DO DTS^SDUTL
SET SDRE1=Y
End DoDot:1
+9 ;
+10 IF $SELECT('$DATA(SDIN):0,'SDIN:0,SDIN>DT:0,SDRE'>DT&(SDRE):0,1:1)
Begin DoDot:1
+11 WRITE !,*7,"Clinic is inactive ",$SELECT(SDRE:"from ",1:"as of ")
+12 SET Y=SDIN
DO DTS^SDUTL
WRITE Y,$SELECT(SDRE:" to "_SDRE1,1:"")
End DoDot:1
GOTO CR
+13 ;
+14 KILL DIR
SET DIR(0)="D^::EXR"
SET DIR("B")="NOW"
+15 SET DIR("A")="REQUEST DATE/TIME:"
DO ^DIR
IF $DATA(DIRUT)
QUIT
IF Y=-1
QUIT
+16 DO OKTD^SDI
+17 QUIT
+18 ;
+19 ;
APPT ; -- SUBRTN to display today's appointments
+1 KILL ASDCT,ASDS,ASDE,ASDA
+2 ;
+3 SET ASDS=DT-.0001
SET ASDE=DT+.2400
+4 SET X=$ORDER(^DPT(DFN,"S",ASDS))
IF 'X!(X>ASDE)
Begin DoDot:1
+5 WRITE !!?5,"** NO PENDING APPOINTMENTS FOR TODAY **",!
End DoDot:1
QUIT
+6 ;
+7 WRITE !!?20,"**** TODAY'S APPOINTMENTS ****"
+8 FOR
SET ASDS=$ORDER(^DPT(DFN,"S",ASDS))
IF 'ASDS!(ASDS>ASDE)
QUIT
Begin DoDot:1
+9 IF "I"[$PIECE(^DPT(DFN,"S",ASDS,0),U,2)
Begin DoDot:2
+10 SET ASDCT=$GET(ASDCT)+1
+11 SET Y=ASDS
DO CHKSO^SDM
IF $X>9
WRITE !,ASDCT
WRITE ?11
DO DT^SDM0
WRITE ?32
SET DA=+SSC
+12 WRITE SDLN,$SELECT($DATA(^SC(DA,0)):$PIECE(^(0),U),1:"DELETED CLINIC ")
+13 WRITE COV," "
+14 IF $PIECE(^DPT(DFN,"S",ASDS,0),U,7)=4
Begin DoDot:3
+15 ;W "UNSCHEDULED" S ASDA(ASDCT)=ASDS_U_1_U_+SSC ;PATCH 5
+16 ;PATCH 5
WRITE "UNSCHEDULED"
SET ASDA(ASDCT)=ASDS_U_1_U_+SSC_U_$$CHECKIN
End DoDot:3
QUIT
+17 IF $PIECE(^DPT(DFN,"S",ASDS,0),U,7)=3
Begin DoDot:3
+18 SET ASDCKI=$$CHECKIN
IF ASDCKI=""
SET ASDA(ASDCT)=ASDS_U_0_U_+SSC
QUIT
+19 WRITE !?15,"CHECKED-IN at "
SET Y=ASDCKI
DO DT^SDM0
+20 ;S ASDA(ASDCT)=ASDS_U_1_U_+SSC ;PATCH 5
+21 ;PATCH 5
SET ASDA(ASDCT)=ASDS_U_1_U_+SSC_U_ASDCKI
End DoDot:3
KILL ASDCKI
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
CHKR ;EP; called by CHKR to print IHS forms
+1 NEW DIR
SET DIR(0)="YO"
SET DIR("B")="YES"
+2 SET DIR("A")="WANT TO PRINT ROUTING SLIP NOW"
DO ^DIR
IF Y<1
QUIT
SET SDZRS=Y
+3 KILL IOP
SET (SDX,SDSTART,ORDER,SDREP,SDZCV)=""
+4 SET (SDZEF,SDZHS,SDZMP,SDZAI)=1
DO FORMS
+5 SET SDZSC=SC
SET SDZDFN=DFN
IF SDZRS=1
DO EN^SDROUT1
+6 IF $PIECE($GET(^DG(40.8,$$DIV^ASDUT,"IHS")),U,4)'=1
DO HS
+7 KILL SDZCV,SDZHS,SDZEF,SDZMP,SDZAI,SDZSC,SDZRS,SDZDFN
+8 QUIT
+9 ;
FORMS ; -- checks if forms to be printed
+1 IF $PIECE($GET(^DG(40.8,$$DIV^ASDUT,"IHS")),U,4)'=1
QUIT
FORMS1 ;
+1 IF $PIECE($GET(^SC(SC,9999999)),U)="Y"
IF $$HSTYP^ASDUT(SC,DFN)]""
SET SDZHS=0_U_$$HSTYP^ASDUT(SC,DFN)
+2 IF $PIECE($GET(^SC(SC,9999999)),U,5)="Y"
SET SDZEF=0
+3 IF $PIECE($GET(^SC(SC,9999999)),U,3)="Y"
SET SDZMP=0
+4 IF $PIECE($GET(^SC(SC,9999999)),U,4)="Y"
SET SDZAI=0
+5 QUIT
+6 ;
HS ; -- prints HS and other forms if set to YES for clinic
+1 NEW SC,DFN
+2 SET SC=SDZSC
SET DFN=SDZDFN
+3 IF $PIECE($GET(^SC(SC,9999999)),U,1)'="Y"
QUIT
+4 SET (SDZEF,SDZHS,SDZMP,SDZAI)=1
DO FORMS1
+5 IF (SDZEF=1)
IF (+SDZHS=1)
IF (SDZMP=1)
IF (SDZAI=1)
QUIT
+6 IF $$DFWI=""
Begin DoDot:1
+7 WRITE !!,"Ready to print Health Summary now . . "
+8 SET %ZIS=""
DO ^%ZIS
End DoDot:1
IF POP
QUIT
+9 SET ZTIO=$SELECT($$DFWI]"":$$DFWI,1:ION)
+10 SET ZTRTN="HS1^ASDI"
SET ZTDESC="HS & OTHER FORMS"
SET ZTDTH=$HOROLOG
+11 FOR I="DFN","SDZEF","SDZHS","SDZMP","SDZAI","SDZSC","SDPR"
SET ZTSAVE(I)=""
+12 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
QUIT
+13 ;
HS1 ;EP; called by ZTLOAD to print forms
+1 USE IO
+2 IF SDZEF=0
DO EF^ASDFORM(SDZSC,DFN,SDPR)
+3 IF +SDZHS=0
DO HS^ASDFORM(DFN,$PIECE(SDZHS,U,2))
+4 IF SDZMP=0
DO MP^ASDFORM(DFN)
+5 IF SDZAI=0
DO AIU^ASDFORM(DFN)
+6 DO ^%ZISC
+7 QUIT
+8 ;
DFWI() ; -- returns default health summary printer
+1 QUIT $$VAL^XBDIQ1(40.8,$$DIV^ASDUT,9999999.06)
+2 ;
CHECKIN() ; -- returns check-in time
+1 NEW X,Y,QUIT,CLN
+2 SET CLN=$$CLN
+3 SET X=0
FOR
SET X=$ORDER(^SC(CLN,"S",ASDS,1,X))
IF 'X!($DATA(QUIT))
QUIT
Begin DoDot:1
+4 IF $PIECE(^SC(CLN,"S",ASDS,1,X,0),U)'=DFN
QUIT
+5 SET Y=$GET(^SC(CLN,"S",ASDS,1,X,"C"))
IF Y]""
SET QUIT=""
End DoDot:1
+6 QUIT $GET(Y)
+7 ;
SCX() ; -- returns multiple ien for patient in ^sc
+1 NEW X
+2 SET X=0
+3 FOR
SET X=$ORDER(^SC(I(SDPR),"S",SDPR,1,X))
IF 'X
QUIT
IF (+^(X,0)=DFN)
QUIT
+4 QUIT X
+5 ;
CLN() ; -- returns clinic ien
+1 QUIT $PIECE(^DPT(DFN,"S",ASDS,0),U)
+2 ;
