ASDN1.m

ASDN1 ; IHS/ADC/PDW/ENM - IHS CHANGES TO NO-SHOW LETTERS ; [ 09/26/2000  3:55 PM ]

 ;;5.0;IHS SCHEDULING;**5**;MAR 25, 1999

 ;

ARBK(DATE) ;EP; called by SDN1 to find if uncancelled auto-rebooked appt exists

 ; -- DATE is date of rebooked appt; returns value to SDR

 NEW ASDY,ASDZ

 S ASDY=$P($G(^DPT(DFN,"S",DATE,0)),U,2) I ASDY="" Q 1

 ;IHS/ASDST/POC/ENM NX LINE CHNG C=CANCEL, N=NOSHOW, PC=PATIENT CANCEL

 ;I ASDY="C"!(ASDY="N") Q 0

 I ((ASDY="C")!(ASDY="N")!(ASDY="PC")) Q 0 ;IHS/ASDST/POC/ENM 09/26/00

 ;I ASDY["A" S ASDZ=$P(^DPT(DFN,"S",DATE,0),U,10) I ASDZ="" Q 0

 S ASDZ=$P(^DPT(DFN,"S",DATE,0),U,10) I ((ASDY["A")&(ASDZ=""))!(ASDZ="") Q 0 ;INS/ASDST/POC/ENM 09/26/00 "A"=AUTO-REBOOK STATUS

 I $P($G(^DPT(DFN,"S",ASDZ,0)),U,2)'["C" Q 1

 Q $$ARBK(ASDZ)

 ;

FINDA ;EP called by SDN1 to find uncancld auto-rebooked appt

 ; -- variables to reset SDX,SDC,S

 NEW ASDX,ASDY,ASDZ

 S ASDX=SDX

 S ASDY=$P($G(^DPT(DFN,"S",ASDX,0)),U,2) I ASDY="" Q  ;okay

 I ASDY="C"!(ASDY="N") S ASDQ="" Q  ;deadend, no new appt

 S ASDZ=$P(^DPT(DFN,"S",ASDX,0),U,10)

 I ASDZ="" S ASDQ="" Q  ;deadend all cancelled

 S SDX=ASDZ,S=^DPT(DFN,"S",SDX,0),SDC=$P(^(0),U)

 I $P($G(^DPT(DFN,"S",ASDZ,0)),U,2)'["C" Q  ;this one okay

 D FINDA Q  ;loop again

 ;

RBKDT(SDX,DFN) ;EP called by SDNOS1 to return date of uncancld rebooked appt

 NEW SDC,S D FINDA Q SDX

ASDN1     ; IHS/ADC/PDW/ENM - IHS CHANGES TO NO-SHOW LETTERS ; [ 09/26/2000  3:55 PM ]

 +1       ;;5.0;IHS SCHEDULING;**5**;MAR 25, 1999

 +2       ;

ARBK(DATE) ;EP; called by SDN1 to find if uncancelled auto-rebooked appt exists

 +1       ; -- DATE is date of rebooked appt; returns value to SDR

 +2        NEW ASDY,ASDZ

 +3        SET ASDY=$PIECE($GET(^DPT(DFN,"S",DATE,0)),U,2)

           IF ASDY=""

               QUIT 1

 +4       ;IHS/ASDST/POC/ENM NX LINE CHNG C=CANCEL, N=NOSHOW, PC=PATIENT CANCEL

 +5       ;I ASDY="C"!(ASDY="N") Q 0

 +6       ;IHS/ASDST/POC/ENM 09/26/00

           IF ((ASDY="C")!(ASDY="N")!(ASDY="PC"))

               QUIT 0

 +7       ;I ASDY["A" S ASDZ=$P(^DPT(DFN,"S",DATE,0),U,10) I ASDZ="" Q 0

 +8       ;INS/ASDST/POC/ENM 09/26/00 "A"=AUTO-REBOOK STATUS

           SET ASDZ=$PIECE(^DPT(DFN,"S",DATE,0),U,10)

           IF ((ASDY["A")&(ASDZ=""))!(ASDZ="")

               QUIT 0

 +9        IF $PIECE($GET(^DPT(DFN,"S",ASDZ,0)),U,2)'["C"

               QUIT 1

 +10       QUIT $$ARBK(ASDZ)

 +11      ;

FINDA     ;EP called by SDN1 to find uncancld auto-rebooked appt

 +1       ; -- variables to reset SDX,SDC,S

 +2        NEW ASDX,ASDY,ASDZ

 +3        SET ASDX=SDX

 +4       ;okay

           SET ASDY=$PIECE($GET(^DPT(DFN,"S",ASDX,0)),U,2)

           IF ASDY=""

               QUIT 

 +5       ;deadend, no new appt

           IF ASDY="C"!(ASDY="N")

               SET ASDQ=""

               QUIT 

 +6        SET ASDZ=$PIECE(^DPT(DFN,"S",ASDX,0),U,10)

 +7       ;deadend all cancelled

           IF ASDZ=""

               SET ASDQ=""

               QUIT 

 +8        SET SDX=ASDZ

           SET S=^DPT(DFN,"S",SDX,0)

           SET SDC=$PIECE(^(0),U)

 +9       ;this one okay

           IF $PIECE($GET(^DPT(DFN,"S",ASDZ,0)),U,2)'["C"

               QUIT 

 +10      ;loop again

           DO FINDA

           QUIT 

 +11      ;

RBKDT(SDX,DFN) ;EP called by SDNOS1 to return date of uncancld rebooked appt

 +1        NEW SDC,S

           DO FINDA

           QUIT SDX