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 Nov 22, 2024@17:59 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
