AMQQAPT ; IHS/CMI/THL - PATIENT APPOINTMENTS;
;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
;
APT(DFN,ADT,EDT,JOB) ;EP;
;CREATE AND DISPLAY LIST OF FUTURE APPOINTMENTS FOR A PATIENT
;DFN - PATIENT IEN
;CLN - CLINIC(S) TO INCLUDE
;ADT - START DATE
;EDT - END DATE
;JOB - $J
;AMQQCLN - CLINIC
;AMQQDT - DISPLAYED DATA
;AMQQPOV - APPT PURPOSE
;AMQQTYP - TYPE OF APPT
;
N AMQQCLN,AMQQDT,AMQQPOV,AMQQTYP,POV
N X,Y,Z
S:'$G(JOB) JOB=$J
S AMQQJOB=JOB
S ADT=$$FMADD^XLFDT(DT,-1) ;always start with yesterday
S:'$G(EDT) EDT=9999999
S ADT=ADT_".9999" ;start with last time yesterday
F S ADT=$O(^DPT(DFN,"S",ADT)) Q:'ADT!($P(ADT,".")>EDT) S X=^(ADT,0) D
.I $O(^TMP(AMQQJOB,"AMQQAPT","AMQQCLN",0)),$G(^TMP(AMQQJOB,"AMQQAPT","AMQQCLN"))'="ALL"&'$D(^TMP(AMQQJOB,"AMQQAPT","AMQQCLN",+X)) Q
.S AMQQCLN=$E($P($G(^SC(+X,0)),U),1,15)
.S AMQQDT=$E(ADT,4,5)_"/"_$E(ADT,6,7)_"/"_($E(ADT,1,3)+1700)
.S AMQQTYP=+$P(X,U,16)
.S AMQQTYP=$E($P($G(^SD(409.1,AMQQTYP,0)),U),1,15)
.S AMQQPOV=$P(X,U,7)
.I AMQQPOV D I 1
..S AMQQPOV=$P($P($P(^DD(2.98,9,0),U,3),(AMQQPOV_":"),2),";")
.E S AMQQPOV="NOT STATED"
.S AMQQPOV=$E(AMQQPOV,1,13)
.S X=""
.S $E(X,10)=AMQQDT
.S $E(X,25)=AMQQCLN
.S $E(X,42)=AMQQPOV
.S $E(X,57)=AMQQTYP
.S ^TMP($J,"AMQQAPT",DFN,ADT)=X
.W !,X
.S AMQQTOT=$G(AMQQTOT)+1
.I AMQQTOT#(IOSL-6-(5*($E(IOST,1,2)="P-")))=1 D ^AMQQDOH I AMQP(AMQQOV)=99999999999 Q
Q
QAPT ;EP;
;QUERY WHETHER TO INCLUDE PATIENT APPOINTMENTS IN QMAN DISPLAY
NEW X,Y,X2
D CAPT
S AMQQJOB=$J
K DIR
S DIR(0)="YO"
S DIR("A")="Include list of upcoming appts for the patient"
S DIR("B")="NO"
W !!
D ^DIR
K DIR
I 'Y D CAPT Q
S X1=DT
S X2=365
D C^%DTC
S DIR(0)="D^::EF"
S DIR("A")="End date for appointments to include.........."
S DIR("B")=X
S Y=X
X ^DD("DD")
S DIR("B")=Y
D ^DIR
K DIR
I 'Y D CAPT Q
S ^TMP($J,"AMQQAPT")=Y
S AMQQEDT=Y
S AMQQADT=DT-.0001
K ^TMP($J,"AMQQAPT","AMQQCLN"),AMQQSTOP,CLN
S DIR(0)="YO"
S DIR("A")="Include appointments for all clinics.........."
S DIR("B")="YES"
D ^DIR
K DIR
I Y=1 S ^TMP($J,"AMQQAPT","AMQQCLN")="ALL" Q
W !!
F D SC Q:$D(AMQQSTOP)
K AMQSTOP
Q:'$D(^TMP($J,"AMQQAPT","AMQQCLN"))
Q
SC ;SELECT CLINICS AND CREATE CLINIC ARRAY
K DIC
S DIC="^SC("
S DIC(0)="AMQEZ"
S DIC("A")="Select"_$S($O(^TMP($J,"AMQQAPT","AMQQCLN",0)):" another",1:"")_" Clinic: "
W !
D ^DIC
K DIC,DD,DR,DA
I Y<1 S AMQQSTOP="" Q
S ^TMP($J,"AMQQAPT","AMQQCLN",+Y)=""
Q
CAPT ;CLEAN UP
K AMQQDT,AMQQADT,AMQQEDT,AMQQCLN,AMQQPOV,AMQQTYP,AMQQJOB
K ^TMP($J,"AMQQAPT")
Q
AMQQAPT ; IHS/CMI/THL - PATIENT APPOINTMENTS;
+1 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
+2 ;
APT(DFN,ADT,EDT,JOB) ;EP;
+1 ;CREATE AND DISPLAY LIST OF FUTURE APPOINTMENTS FOR A PATIENT
+2 ;DFN - PATIENT IEN
+3 ;CLN - CLINIC(S) TO INCLUDE
+4 ;ADT - START DATE
+5 ;EDT - END DATE
+6 ;JOB - $J
+7 ;AMQQCLN - CLINIC
+8 ;AMQQDT - DISPLAYED DATA
+9 ;AMQQPOV - APPT PURPOSE
+10 ;AMQQTYP - TYPE OF APPT
+11 ;
+12 NEW AMQQCLN,AMQQDT,AMQQPOV,AMQQTYP,POV
+13 NEW X,Y,Z
+14 IF '$GET(JOB)
SET JOB=$JOB
+15 SET AMQQJOB=JOB
+16 ;always start with yesterday
SET ADT=$$FMADD^XLFDT(DT,-1)
+17 IF '$GET(EDT)
SET EDT=9999999
+18 ;start with last time yesterday
SET ADT=ADT_".9999"
+19 FOR
SET ADT=$ORDER(^DPT(DFN,"S",ADT))
IF 'ADT!($PIECE(ADT,".")>EDT)
QUIT
SET X=^(ADT,0)
Begin DoDot:1
+20 IF $ORDER(^TMP(AMQQJOB,"AMQQAPT","AMQQCLN",0))
IF $GET(^TMP(AMQQJOB,"AMQQAPT","AMQQCLN"))'="ALL"&'$DATA(^TMP(AMQQJOB,"AMQQAPT","AMQQCLN",+X))
QUIT
+21 SET AMQQCLN=$EXTRACT($PIECE($GET(^SC(+X,0)),U),1,15)
+22 SET AMQQDT=$EXTRACT(ADT,4,5)_"/"_$EXTRACT(ADT,6,7)_"/"_($EXTRACT(ADT,1,3)+1700)
+23 SET AMQQTYP=+$PIECE(X,U,16)
+24 SET AMQQTYP=$EXTRACT($PIECE($GET(^SD(409.1,AMQQTYP,0)),U),1,15)
+25 SET AMQQPOV=$PIECE(X,U,7)
+26 IF AMQQPOV
Begin DoDot:2
+27 SET AMQQPOV=$PIECE($PIECE($PIECE(^DD(2.98,9,0),U,3),(AMQQPOV_":"),2),";")
End DoDot:2
IF 1
+28 IF '$TEST
SET AMQQPOV="NOT STATED"
+29 SET AMQQPOV=$EXTRACT(AMQQPOV,1,13)
+30 SET X=""
+31 SET $EXTRACT(X,10)=AMQQDT
+32 SET $EXTRACT(X,25)=AMQQCLN
+33 SET $EXTRACT(X,42)=AMQQPOV
+34 SET $EXTRACT(X,57)=AMQQTYP
+35 SET ^TMP($JOB,"AMQQAPT",DFN,ADT)=X
+36 WRITE !,X
+37 SET AMQQTOT=$GET(AMQQTOT)+1
+38 IF AMQQTOT#(IOSL-6-(5*($EXTRACT(IOST,1,2)="P-")))=1
DO ^AMQQDOH
IF AMQP(AMQQOV)=99999999999
QUIT
End DoDot:1
+39 QUIT
QAPT ;EP;
+1 ;QUERY WHETHER TO INCLUDE PATIENT APPOINTMENTS IN QMAN DISPLAY
+2 NEW X,Y,X2
+3 DO CAPT
+4 SET AMQQJOB=$JOB
+5 KILL DIR
+6 SET DIR(0)="YO"
+7 SET DIR("A")="Include list of upcoming appts for the patient"
+8 SET DIR("B")="NO"
+9 WRITE !!
+10 DO ^DIR
+11 KILL DIR
+12 IF 'Y
DO CAPT
QUIT
+13 SET X1=DT
+14 SET X2=365
+15 DO C^%DTC
+16 SET DIR(0)="D^::EF"
+17 SET DIR("A")="End date for appointments to include.........."
+18 SET DIR("B")=X
+19 SET Y=X
+20 XECUTE ^DD("DD")
+21 SET DIR("B")=Y
+22 DO ^DIR
+23 KILL DIR
+24 IF 'Y
DO CAPT
QUIT
+25 SET ^TMP($JOB,"AMQQAPT")=Y
+26 SET AMQQEDT=Y
+27 SET AMQQADT=DT-.0001
+28 KILL ^TMP($JOB,"AMQQAPT","AMQQCLN"),AMQQSTOP,CLN
+29 SET DIR(0)="YO"
+30 SET DIR("A")="Include appointments for all clinics.........."
+31 SET DIR("B")="YES"
+32 DO ^DIR
+33 KILL DIR
+34 IF Y=1
SET ^TMP($JOB,"AMQQAPT","AMQQCLN")="ALL"
QUIT
+35 WRITE !!
+36 FOR
DO SC
IF $DATA(AMQQSTOP)
QUIT
+37 KILL AMQSTOP
+38 IF '$DATA(^TMP($JOB,"AMQQAPT","AMQQCLN"))
QUIT
+39 QUIT
SC ;SELECT CLINICS AND CREATE CLINIC ARRAY
+1 KILL DIC
+2 SET DIC="^SC("
+3 SET DIC(0)="AMQEZ"
+4 SET DIC("A")="Select"_$SELECT($ORDER(^TMP($JOB,"AMQQAPT","AMQQCLN",0)):" another",1:"")_" Clinic: "
+5 WRITE !
+6 DO ^DIC
+7 KILL DIC,DD,DR,DA
+8 IF Y<1
SET AMQQSTOP=""
QUIT
+9 SET ^TMP($JOB,"AMQQAPT","AMQQCLN",+Y)=""
+10 QUIT
CAPT ;CLEAN UP
+1 KILL AMQQDT,AMQQADT,AMQQEDT,AMQQCLN,AMQQPOV,AMQQTYP,AMQQJOB
+2 KILL ^TMP($JOB,"AMQQAPT")
+3 QUIT
