SDCI.m

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 ---SDCI   799     printed  Apr 09, 2024@21:45:50                                                                                                                                                                                                         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