- SDWLE1 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM
- ;;5.3;scheduling;**263,417,1015**;AUG 13 1993;Build 21
- ;
- ;
- ;******************************************************************
- ; CHANGE LOG
- ;
- ; DATE PATCH DESCRIPTION
- ; ---- ----- -----------
- ; 07/20/02 263 This routine should be re-designed for release 1 if time
- ; permits. Otherwise for release 2. Requirements were not provided
- ; timely and retrofiting created poorly constructed routine.
- ;
- ; 02/16/05 417 API updates, modified PCMM API calls. Modified POSITION display.
- ;
- ;
- ;
- PCM ;Check ^SCTM(404.41) for Outpatient Profile Data. - KF requirement - recieved 07/18/02
- S (SDWLSTO,SDWLSPO,SDWLSSO,SDWLSCO,SDWLCT)="",SDWLTEM=0,SDWLPOS=0 N SDWLCPT,SDWLPOS,SDWLCN S SDWLCN=0
- S SDWLCP1=$P($$NMPCPR^SCAPMCU2(DFN,DT,1),U,2)
- S SDWLCP2=$P($$NMPCPR^SCAPMCU2(DFN,DT,2),U,2)
- ;patch SD*5.3*417
- S SDWLCP3=$P($$NMPCTM^SCAPMCU2(DFN,DT,1),U,2),SDWLCT=$P($$NMPCTM^SCAPMCU2(DFN,DT,1),U,1) S:+SDWLCT>0 SDWLCN=SDWLCN+1
- S SDWLCP4=$P($$NMPCTP^SCAPMCU2(DFN,DT,1),U,2),SDWLCP4N=$P($$NMPCTP^SCAPMCU2(DFN,DT,1),U,1)
- S SDWLCP5=$P($$NMPCTP^SCAPMCU2(DFN,DT,2),U,2)
- S SDWLCP6=$P($$NMPCPR^SCAPMCU2(DFN,DT,3),U,2)
- S SDWLPCMM=1
- Q
- PCMD ;Display PCMM data
- S SDWLTEM=0,SDWLPOS=0
- I SDWLPCMM D
- .W !
- .;PATCH SD*5.3*417
- .I $D(SDWLCP3),SDWLCP3'="" W !,"PC Team: ",SDWLCP3 S SDWLTEM=1
- .I $D(SDWLCP1),SDWLCP1'="" W !,"PC Practitioner: ",SDWLCP1 S SDWLPOS=1
- .I $D(SDWLCP2),SDWLCP2'="" W !,"PC Attending:",SDWLCP2
- .I $D(SDWLCP5),SDWLCP5'="" W !,"PC Attending Position: ",SDWLCP5 S SDWLPOS=1
- .I $D(SDWLCP6),SDWLCP6'="" W !,"Associate PC Provider: ",SDWLCP6
- .;patch SD*5.3*417
- .I $D(SDWLCP4),SDWLCP4'="" W !,"PC Team Position: ",SDWLCP4 S SDWPPOS=1
- I $D(SDWLDA),SDWLDA,$D(^SDWL(409.3,SDWLDA,0)) S SDWPCMM=$G(^(0)) D
- .I $P(^SDWL(409.3,SDWLDA,0),U,5) S SDWLCP3=$$EXTERNAL^DILFD(409.3,5,,$P(^(0),U,5))
- .I $P(^SDWL(409.3,SDWLDA,0),U,6) S SDWLCP5=$$EXTERNAL^DILFD(409.3,6,,$P(^(0),U,6))
- Q
- SDWLE1 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM
- +1 ;;5.3;scheduling;**263,417,1015**;AUG 13 1993;Build 21
- +2 ;
- +3 ;
- +4 ;******************************************************************
- +5 ; CHANGE LOG
- +6 ;
- +7 ; DATE PATCH DESCRIPTION
- +8 ; ---- ----- -----------
- +9 ; 07/20/02 263 This routine should be re-designed for release 1 if time
- +10 ; permits. Otherwise for release 2. Requirements were not provided
- +11 ; timely and retrofiting created poorly constructed routine.
- +12 ;
- +13 ; 02/16/05 417 API updates, modified PCMM API calls. Modified POSITION display.
- +14 ;
- +15 ;
- +16 ;
- PCM ;Check ^SCTM(404.41) for Outpatient Profile Data. - KF requirement - recieved 07/18/02
- +1 SET (SDWLSTO,SDWLSPO,SDWLSSO,SDWLSCO,SDWLCT)=""
- SET SDWLTEM=0
- SET SDWLPOS=0
- NEW SDWLCPT,SDWLPOS,SDWLCN
- SET SDWLCN=0
- +2 SET SDWLCP1=$PIECE($$NMPCPR^SCAPMCU2(DFN,DT,1),U,2)
- +3 SET SDWLCP2=$PIECE($$NMPCPR^SCAPMCU2(DFN,DT,2),U,2)
- +4 ;patch SD*5.3*417
- +5 SET SDWLCP3=$PIECE($$NMPCTM^SCAPMCU2(DFN,DT,1),U,2)
- SET SDWLCT=$PIECE($$NMPCTM^SCAPMCU2(DFN,DT,1),U,1)
- IF +SDWLCT>0
- SET SDWLCN=SDWLCN+1
- +6 SET SDWLCP4=$PIECE($$NMPCTP^SCAPMCU2(DFN,DT,1),U,2)
- SET SDWLCP4N=$PIECE($$NMPCTP^SCAPMCU2(DFN,DT,1),U,1)
- +7 SET SDWLCP5=$PIECE($$NMPCTP^SCAPMCU2(DFN,DT,2),U,2)
- +8 SET SDWLCP6=$PIECE($$NMPCPR^SCAPMCU2(DFN,DT,3),U,2)
- +9 SET SDWLPCMM=1
- +10 QUIT
- PCMD ;Display PCMM data
- +1 SET SDWLTEM=0
- SET SDWLPOS=0
- +2 IF SDWLPCMM
- Begin DoDot:1
- +3 WRITE !
- +4 ;PATCH SD*5.3*417
- +5 IF $DATA(SDWLCP3)
- IF SDWLCP3'=""
- WRITE !,"PC Team: ",SDWLCP3
- SET SDWLTEM=1
- +6 IF $DATA(SDWLCP1)
- IF SDWLCP1'=""
- WRITE !,"PC Practitioner: ",SDWLCP1
- SET SDWLPOS=1
- +7 IF $DATA(SDWLCP2)
- IF SDWLCP2'=""
- WRITE !,"PC Attending:",SDWLCP2
- +8 IF $DATA(SDWLCP5)
- IF SDWLCP5'=""
- WRITE !,"PC Attending Position: ",SDWLCP5
- SET SDWLPOS=1
- +9 IF $DATA(SDWLCP6)
- IF SDWLCP6'=""
- WRITE !,"Associate PC Provider: ",SDWLCP6
- +10 ;patch SD*5.3*417
- +11 IF $DATA(SDWLCP4)
- IF SDWLCP4'=""
- WRITE !,"PC Team Position: ",SDWLCP4
- SET SDWPPOS=1
- End DoDot:1
- +12 IF $DATA(SDWLDA)
- IF SDWLDA
- IF $DATA(^SDWL(409.3,SDWLDA,0))
- SET SDWPCMM=$GET(^(0))
- Begin DoDot:1
- +13 IF $PIECE(^SDWL(409.3,SDWLDA,0),U,5)
- SET SDWLCP3=$$EXTERNAL^DILFD(409.3,5,,$PIECE(^(0),U,5))
- +14 IF $PIECE(^SDWL(409.3,SDWLDA,0),U,6)
- SET SDWLCP5=$$EXTERNAL^DILFD(409.3,6,,$PIECE(^(0),U,6))
- End DoDot:1
- +15 QUIT