- SDCI ;SF/GFT,MAN/GRR - CHECK-IN/UNSCHEDULED APPOINTMENT ; 20 SEP 84 8:20 am
- ;;5.3;Scheduling;;Aug 13, 1993
- ;
- PT ;
- N DFN,SDT,SC,SDT,SDDQ,SDD
- W !! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC K DIC G PTQ:Y<0
- S DFN=+Y,SDT=DT,SDD=0
- F S SDT=$O(^DPT(DFN,"S",SDT)) Q:$P(SDT,".")-DT S X=$G(^(SDT,0)) I $P(X,U,2)'["C",$P(X,U,2)'["N"!($P(X,U,2)="NT") S SC=+X D
- .S SDDA=0 F S SDDA=+$O(^SC(SC,"S",SDT,1,SDDA)) Q:'$D(^(SDDA,0)) I DFN=+^(0) D Q
- ..W !!,"Appointment at "_$E(SDT_"000",9,12)_" on ",$$FDATE^VALM1(SDT)," in "_$P(^SC(SC,0),U)
- ..D ONE^SDAM2(DFN,SC,SDT,SDDA,1,"") S SDD=SDD+1
- ;
- W:'SDD *7,!,"This patient has no appointments scheduled today."
- W ! S DIR("A")="Do you want to add a new 'unscheduled' appointment'",DIR(0)="Y"
- D ^DIR K DIR G PTQ:Y'=1
- S SDY=$$CL^SDAMWI(DFN)
- PTQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCI 799 printed Mar 13, 2025@21:53:53 Page 2
- SDCI ;SF/GFT,MAN/GRR - CHECK-IN/UNSCHEDULED APPOINTMENT ; 20 SEP 84 8:20 am
- +1 ;;5.3;Scheduling;;Aug 13, 1993
- +2 ;
- PT ;
- +1 NEW DFN,SDT,SC,SDT,SDDQ,SDD
- +2 WRITE !!
- SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- DO ^DIC
- KILL DIC
- if Y<0
- GOTO PTQ
- +3 SET DFN=+Y
- SET SDT=DT
- SET SDD=0
- +4 FOR
- SET SDT=$ORDER(^DPT(DFN,"S",SDT))
- if $PIECE(SDT,".")-DT
- QUIT
- SET X=$GET(^(SDT,0))
- IF $PIECE(X,U,2)'["C"
- IF $PIECE(X,U,2)'["N"!($PIECE(X,U,2)="NT")
- SET SC=+X
- Begin DoDot:1
- +5 SET SDDA=0
- FOR
- SET SDDA=+$ORDER(^SC(SC,"S",SDT,1,SDDA))
- if '$DATA(^(SDDA,0))
- QUIT
- IF DFN=+^(0)
- Begin DoDot:2
- +6 WRITE !!,"Appointment at "_$EXTRACT(SDT_"000",9,12)_" on ",$$FDATE^VALM1(SDT)," in "_$PIECE(^SC(SC,0),U)
- +7 DO ONE^SDAM2(DFN,SC,SDT,SDDA,1,"")
- SET SDD=SDD+1
- End DoDot:2
- QUIT
- End DoDot:1
- +8 ;
- +9 if 'SDD
- WRITE *7,!,"This patient has no appointments scheduled today."
- +10 WRITE !
- SET DIR("A")="Do you want to add a new 'unscheduled' appointment'"
- SET DIR(0)="Y"
- +11 DO ^DIR
- KILL DIR
- if Y'=1
- GOTO PTQ
- +12 SET SDY=$$CL^SDAMWI(DFN)
- PTQ QUIT
