SDUTL3 ;ALB/REW - Primary Care API Calls ;9/16/10 17:17
;;5.3;PIMS;**30,39,41,148,177,1015,1016**;JUN 30, 2012;Build 20
;
OUTPTPR(DFN,SCDATE,SCPCROLE) ;given patient, return internal^external of the pc practitioner
; Input: DFN - ien of patient file (#2)
; SCDATE - Relevant Date (Default=DT)
; SCPCROLE - Type of PC Role (Default =1 (PC Practitioner),2=Attending
; Returned: pointer to file #200^external value of name
; or, if error or none defined, returns a 0 or null
; Note: This call will continue to be supported with the PCMM release
;
; *** SUPPORTED API ***
;
Q:'$G(DFN) 0
S SCDATE=$G(SCDATE,DT)
S SCPCROLE=$G(SCPCROLE) I $L(SCPCROLE)'=1!(12'[SCPCROLE) S SCPCROLE=1
Q $$NMPCPR^SCAPMCU2(.DFN,.SCDATE,.SCPCROLE)
;
OUTPTAP(DFN,SCDATE) ;given patient, return internal^external of the pc associate provider
; Input: DFN - ien of patient file (#2)
; SCDATE - Relevant Date (Default=DT)
; Returned: pointer to file #200^external value of name
; or, if error or none defined, returns a 0 or null
;
; *** SUPPORTED API ***
;
Q:'$G(DFN) 0
S SCDATE=$G(SCDATE,DT)
Q $$NMPCPR^SCAPMCU2(.DFN,.SCDATE,3)
;
OUTPTTM(DFN,SCDATE,ASSTYPE) ;given patient, return internal^external of the pc team
;Input: DFN - ien of patient file (#2)
; SCDATE - Date of interest (Default=dt)
; ASSTYPE - Assignment Type (Default=1: PC Team)
;
; Returned: pointer to team file (#404.51)
; or, if error or none defined, returns 0 or null
; Note: This call will continue to be supported with the PCMM release
; additional, optional parameters may be added (e.g. effective dt)
;
Q:'$G(DFN) 0
S SCDATE=$G(SCDATE,DT)
S ASSTYPE=$G(ASSTYPE,1)
Q $$NMPCTM^SCAPMCU2(.DFN,.SCDATE,.ASSTYPE)
;
INPTPR(DFN,PRACT) ;store current PC practitioner; return SDOKS=1, if OK
; Input: DFN: ien of patient file (#2)
; PRACT: ien of file #200 if adding,changing field
; null or '@' if deleting field
; Output:SDOKS: 0, if fails to store, 1 otherwise
;
; Note: This data is stored in field #404.01 of the patient file.
; With the release of PCMM, this is no longer a valid method
; to enter provider information for PCMM.
;
; **** PLANNED FOR REMOVAL IN THE FUTURE ****
;
; Selected NEW PERSON entry must be active and must hold provider key
I '$G(DFN)!('$D(PRACT)#2)!('$D(^DPT(+DFN,0))) S SDOKS=0 Q
D EN^DDIOL("Note: This is NOT automatically added to PCMM Files")
D EN^DDIOL("This data should now be entered via PCMM Input Screens")
S SDOKS=1
N DIE,DIC,DR,DA,X
I PRACT=""!(PRACT="@") D G QTIPR
.S DIE="^DPT("
.S DR="404.01////^S X=""@"""
.S DA=DFN
.D ^DIE
I '$$SCREEN^DGPMDD(PRACT) S SDOKS=0 Q
I $D(^VA(200,+PRACT,0)) D
.S DIE="^DPT("
.S DR="404.01////^S X=+PRACT"
.S DA=DFN
.D ^DIE
E D
.S SDOKS=0
QTIPR Q
INPTTM(DFN,TEAM) ;store current PC team; return SDOKS=0, if fails
; Input: DFN: ien of patient file (#2)
; TEAM: ien of file #404.51 if adding,changing field
; null or '@' if deleting field
; Output:SDOKS: 0, if fails to store, 1 otherwise
;
; Note: This data is stored in field #404.02 of the patient file.
; With the release of PCMM, this is no longer a valid method
; to enter team information for PCMM.
;
; **** PLANNED FOR REMOVAL IN THE FUTURE ****
;
I '$G(DFN)!('$D(TEAM)#2)!('$D(^DPT(+DFN,0))) S SDOKS=0 Q
D EN^DDIOL("This data should now be entered via PCMM Input Screens")
N DIE,DIC,DR,DA,X
S SDOKS=1
I TEAM=""!(TEAM="@") D G QTITM
.S DIE="^DPT("
.S DR="404.02////^S X=""@"""
.S DA=DFN
.D ^DIE
I $D(^SCTM(404.51,+TEAM,0)) D
.S DIE="^DPT("
.S DR="404.02////^S X=+TEAM"
.S DA=DFN
.D ^DIE
E D
.S SDOKS=0
QTITM Q
;
UPDLOCAL ;Called from SD EDIT LOCAL STOP CODE NAME option. Allows entry of the .01 field of file 40.7 only if the amis code indicates it is a local entry
;Entire section added in patch 568
N DIC,DIE,SDASC,DA,Y,X,DR
W !!,"You may only edit the NAME field of locally defined entries.",!,"Enter ?? to see the list of entries you're allowed to edit.",!
S DIC=40.7,DIC(0)="AEMQ",DIC("S")="S SDASC=+$P(^DIC(40.7,+Y,0),U,2) I SDASC&(SDASC>450)&(SDASC<486)&(SDASC'=457)&(SDASC'=474)&(SDASC'=480)&(SDASC'=481)" ;only allows local amis codes
D ^DIC Q:Y=-1 ;Stop if entry selected isn't one of the local entries
S DIE=40.7,DA=+Y,DR=".01"
D ^DIE
Q ;End of section
SDUTL3 ;ALB/REW - Primary Care API Calls ;9/16/10 17:17
+1 ;;5.3;PIMS;**30,39,41,148,177,1015,1016**;JUN 30, 2012;Build 20
+2 ;
OUTPTPR(DFN,SCDATE,SCPCROLE) ;given patient, return internal^external of the pc practitioner
+1 ; Input: DFN - ien of patient file (#2)
+2 ; SCDATE - Relevant Date (Default=DT)
+3 ; SCPCROLE - Type of PC Role (Default =1 (PC Practitioner),2=Attending
+4 ; Returned: pointer to file #200^external value of name
+5 ; or, if error or none defined, returns a 0 or null
+6 ; Note: This call will continue to be supported with the PCMM release
+7 ;
+8 ; *** SUPPORTED API ***
+9 ;
+10 IF '$GET(DFN)
QUIT 0
+11 SET SCDATE=$GET(SCDATE,DT)
+12 SET SCPCROLE=$GET(SCPCROLE)
IF $LENGTH(SCPCROLE)'=1!(12'[SCPCROLE)
SET SCPCROLE=1
+13 QUIT $$NMPCPR^SCAPMCU2(.DFN,.SCDATE,.SCPCROLE)
+14 ;
OUTPTAP(DFN,SCDATE) ;given patient, return internal^external of the pc associate provider
+1 ; Input: DFN - ien of patient file (#2)
+2 ; SCDATE - Relevant Date (Default=DT)
+3 ; Returned: pointer to file #200^external value of name
+4 ; or, if error or none defined, returns a 0 or null
+5 ;
+6 ; *** SUPPORTED API ***
+7 ;
+8 IF '$GET(DFN)
QUIT 0
+9 SET SCDATE=$GET(SCDATE,DT)
+10 QUIT $$NMPCPR^SCAPMCU2(.DFN,.SCDATE,3)
+11 ;
OUTPTTM(DFN,SCDATE,ASSTYPE) ;given patient, return internal^external of the pc team
+1 ;Input: DFN - ien of patient file (#2)
+2 ; SCDATE - Date of interest (Default=dt)
+3 ; ASSTYPE - Assignment Type (Default=1: PC Team)
+4 ;
+5 ; Returned: pointer to team file (#404.51)
+6 ; or, if error or none defined, returns 0 or null
+7 ; Note: This call will continue to be supported with the PCMM release
+8 ; additional, optional parameters may be added (e.g. effective dt)
+9 ;
+10 IF '$GET(DFN)
QUIT 0
+11 SET SCDATE=$GET(SCDATE,DT)
+12 SET ASSTYPE=$GET(ASSTYPE,1)
+13 QUIT $$NMPCTM^SCAPMCU2(.DFN,.SCDATE,.ASSTYPE)
+14 ;
INPTPR(DFN,PRACT) ;store current PC practitioner; return SDOKS=1, if OK
+1 ; Input: DFN: ien of patient file (#2)
+2 ; PRACT: ien of file #200 if adding,changing field
+3 ; null or '@' if deleting field
+4 ; Output:SDOKS: 0, if fails to store, 1 otherwise
+5 ;
+6 ; Note: This data is stored in field #404.01 of the patient file.
+7 ; With the release of PCMM, this is no longer a valid method
+8 ; to enter provider information for PCMM.
+9 ;
+10 ; **** PLANNED FOR REMOVAL IN THE FUTURE ****
+11 ;
+12 ; Selected NEW PERSON entry must be active and must hold provider key
+13 IF '$GET(DFN)!('$DATA(PRACT)#2)!('$DATA(^DPT(+DFN,0)))
SET SDOKS=0
QUIT
+14 DO EN^DDIOL("Note: This is NOT automatically added to PCMM Files")
+15 DO EN^DDIOL("This data should now be entered via PCMM Input Screens")
+16 SET SDOKS=1
+17 NEW DIE,DIC,DR,DA,X
+18 IF PRACT=""!(PRACT="@")
Begin DoDot:1
+19 SET DIE="^DPT("
+20 SET DR="404.01////^S X=""@"""
+21 SET DA=DFN
+22 DO ^DIE
End DoDot:1
GOTO QTIPR
+23 IF '$$SCREEN^DGPMDD(PRACT)
SET SDOKS=0
QUIT
+24 IF $DATA(^VA(200,+PRACT,0))
Begin DoDot:1
+25 SET DIE="^DPT("
+26 SET DR="404.01////^S X=+PRACT"
+27 SET DA=DFN
+28 DO ^DIE
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET SDOKS=0
End DoDot:1
QTIPR QUIT
INPTTM(DFN,TEAM) ;store current PC team; return SDOKS=0, if fails
+1 ; Input: DFN: ien of patient file (#2)
+2 ; TEAM: ien of file #404.51 if adding,changing field
+3 ; null or '@' if deleting field
+4 ; Output:SDOKS: 0, if fails to store, 1 otherwise
+5 ;
+6 ; Note: This data is stored in field #404.02 of the patient file.
+7 ; With the release of PCMM, this is no longer a valid method
+8 ; to enter team information for PCMM.
+9 ;
+10 ; **** PLANNED FOR REMOVAL IN THE FUTURE ****
+11 ;
+12 IF '$GET(DFN)!('$DATA(TEAM)#2)!('$DATA(^DPT(+DFN,0)))
SET SDOKS=0
QUIT
+13 DO EN^DDIOL("This data should now be entered via PCMM Input Screens")
+14 NEW DIE,DIC,DR,DA,X
+15 SET SDOKS=1
+16 IF TEAM=""!(TEAM="@")
Begin DoDot:1
+17 SET DIE="^DPT("
+18 SET DR="404.02////^S X=""@"""
+19 SET DA=DFN
+20 DO ^DIE
End DoDot:1
GOTO QTITM
+21 IF $DATA(^SCTM(404.51,+TEAM,0))
Begin DoDot:1
+22 SET DIE="^DPT("
+23 SET DR="404.02////^S X=+TEAM"
+24 SET DA=DFN
+25 DO ^DIE
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 SET SDOKS=0
End DoDot:1
QTITM QUIT
+1 ;
UPDLOCAL ;Called from SD EDIT LOCAL STOP CODE NAME option. Allows entry of the .01 field of file 40.7 only if the amis code indicates it is a local entry
+1 ;Entire section added in patch 568
+2 NEW DIC,DIE,SDASC,DA,Y,X,DR
+3 WRITE !!,"You may only edit the NAME field of locally defined entries.",!,"Enter ?? to see the list of entries you're allowed to edit.",!
+4 ;only allows local amis codes
SET DIC=40.7
SET DIC(0)="AEMQ"
SET DIC("S")="S SDASC=+$P(^DIC(40.7,+Y,0),U,2) I SDASC&(SDASC>450)&(SDASC<486)&(SDASC'=457)&(SDASC'=474)&(SDASC'=480)&(SDASC'=481)"
+5 ;Stop if entry selected isn't one of the local entries
DO ^DIC
IF Y=-1
QUIT
+6 SET DIE=40.7
SET DA=+Y
SET DR=".01"
+7 DO ^DIE
+8 ;End of section
QUIT
