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

ASDI.m

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