- 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
