- DGRP14 ;ALB/MRL/EG/GAH - REGISTRATION SCREEN 14/APPOINTMENT INFORMATION ; 10/18/06
- ;;5.3;PIMS;**568,585,725,770,1015,1016**;JUN 30, 2012;Build 20
- S DGRPS=14 D H^DGRPU S (Z,DGRPW)=1 D WW^DGRPV W " Enrollment Clinics: "
- S I1=""
- F I=0:0 S I=$O(^DPT(DFN,"DE",I)) Q:'I D:$P(^(I,0),U,2)'="I"
- . S I1=1,X=$S($D(^SC(+^(0),0)):$P(^(0),U,1)_", ",1:"")
- . W:(79-$X)<$L(X) !?24 W X
- W:'I1 "NOT ACTIVELY ENROLLED IN ANY CLINICS AT THIS TIME"
- W ! S Z=2 D WW^DGRPV W " Pending Appt's",?18,": " S I1="",I2=DT_".9999"
- N DGARRAY,APTDT,CLIFN,CLNAM
- S DGARRAY("FLDS")="1;2;3",DGARRAY(3)="R;I;NT",DGARRAY(4)=DFN,DGARRAY(1)=DT,DGARRAY("SORT")="P"
- S I1=$$SDAPI^SDAMA301(.DGARRAY)
- ;Check for appointment retrieval error.
- I I1<0 W $$FAPCHK^DGENRPD2 G Q
- S APTDT=0
- F S APTDT=$O(^TMP($J,"SDAMA301",DFN,APTDT)) Q:'APTDT D
- .;check to see if appointment is cancelled, if so
- .;ignore this appointment eg 01/25/2005
- .;I $$CANCEL(DFN,APTDT)="Y" Q TAKEN OUT IN PATCH 770.
- .S CLNAM=$P($P(^TMP($J,"SDAMA301",DFN,APTDT),U,2),";",2)
- .S X=$S(CLNAM]"":CLNAM,1:"UNKNOWN CLINIC")_" ("_$$FMTE^DILIBF(APTDT,"5U")_"), " W:(79-$X)<$L(X) !?24 W X
- .Q
- I 'I1 W "NO PENDING APPOINTMENTS ON FILE"
- Q K I,I1,I2,X,Y,DGARRAY,APTDT,CLNAM,^TMP($J,"SDAMA301") G ^DGRPP
- ;
- ;input DFN - patient id
- ; APPDATE - appointment date
- ;return Y - Yes
- ; N - No
- CANCEL(DFN,APPDATE) ;
- N X,STATUS,U
- S U="^"
- S X=$G(^DPT(DFN,"S",APPDATE,0))
- I X="" Q "Y" ;probably bad data
- S STATUS=$P(X,U,2)
- I STATUS="" Q "N"
- I STATUS="I" Q "N"
- Q "Y"
- DGRP14 ;ALB/MRL/EG/GAH - REGISTRATION SCREEN 14/APPOINTMENT INFORMATION ; 10/18/06
- +1 ;;5.3;PIMS;**568,585,725,770,1015,1016**;JUN 30, 2012;Build 20
- +2 SET DGRPS=14
- DO H^DGRPU
- SET (Z,DGRPW)=1
- DO WW^DGRPV
- WRITE " Enrollment Clinics: "
- +3 SET I1=""
- +4 FOR I=0:0
- SET I=$ORDER(^DPT(DFN,"DE",I))
- IF 'I
- QUIT
- IF $PIECE(^(I,0),U,2)'="I"
- Begin DoDot:1
- +5 SET I1=1
- SET X=$SELECT($DATA(^SC(+^(0),0)):$PIECE(^(0),U,1)_", ",1:"")
- +6 IF (79-$X)<$LENGTH(X)
- WRITE !?24
- WRITE X
- End DoDot:1
- +7 IF 'I1
- WRITE "NOT ACTIVELY ENROLLED IN ANY CLINICS AT THIS TIME"
- +8 WRITE !
- SET Z=2
- DO WW^DGRPV
- WRITE " Pending Appt's",?18,": "
- SET I1=""
- SET I2=DT_".9999"
- +9 NEW DGARRAY,APTDT,CLIFN,CLNAM
- +10 SET DGARRAY("FLDS")="1;2;3"
- SET DGARRAY(3)="R;I;NT"
- SET DGARRAY(4)=DFN
- SET DGARRAY(1)=DT
- SET DGARRAY("SORT")="P"
- +11 SET I1=$$SDAPI^SDAMA301(.DGARRAY)
- +12 ;Check for appointment retrieval error.
- +13 IF I1<0
- WRITE $$FAPCHK^DGENRPD2
- GOTO Q
- +14 SET APTDT=0
- +15 FOR
- SET APTDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,APTDT))
- IF 'APTDT
- QUIT
- Begin DoDot:1
- +16 ;check to see if appointment is cancelled, if so
- +17 ;ignore this appointment eg 01/25/2005
- +18 ;I $$CANCEL(DFN,APTDT)="Y" Q TAKEN OUT IN PATCH 770.
- +19 SET CLNAM=$PIECE($PIECE(^TMP($JOB,"SDAMA301",DFN,APTDT),U,2),";",2)
- +20 SET X=$SELECT(CLNAM]"":CLNAM,1:"UNKNOWN CLINIC")_" ("_$$FMTE^DILIBF(APTDT,"5U")_"), "
- IF (79-$X)<$LENGTH(X)
- WRITE !?24
- WRITE X
- +21 QUIT
- End DoDot:1
- +22 IF 'I1
- WRITE "NO PENDING APPOINTMENTS ON FILE"
- Q KILL I,I1,I2,X,Y,DGARRAY,APTDT,CLNAM,^TMP($JOB,"SDAMA301")
- GOTO ^DGRPP
- +1 ;
- +2 ;input DFN - patient id
- +3 ; APPDATE - appointment date
- +4 ;return Y - Yes
- +5 ; N - No
- CANCEL(DFN,APPDATE) ;
- +1 NEW X,STATUS,U
- +2 SET U="^"
- +3 SET X=$GET(^DPT(DFN,"S",APPDATE,0))
- +4 ;probably bad data
- IF X=""
- QUIT "Y"
- +5 SET STATUS=$PIECE(X,U,2)
- +6 IF STATUS=""
- QUIT "N"
- +7 IF STATUS="I"
- QUIT "N"
- +8 QUIT "Y"
