Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDCO3

SDCO3.m

Go to the documentation of this file.
  1. SDCO3 ;ALB/RMO - Provider - Check Out;08 DEC 1992 4:05 pm
  1. ;;5.3;Scheduling;**28,27,44,67,71,132,466,717**;08/13/93;Build 12
  1. ;
  1. EN ;Entry point for SDCO PROVIDER protocol
  1. ; Input -- SDOE
  1. ;
  1. S VALMBCK=""
  1. ;
  1. ; -- if OLD encounter, quit
  1. IF '$$EDITOK($G(SDOE),1) G ENQ
  1. ;
  1. ; -- call PCE interview
  1. N SDVISIT,SDHL
  1. S SDVISIT=$P($G(^SCE(+SDOE,0)),U,5)
  1. S X=$$INTV^PXAPI("PRV","SD","PIMS",SDVISIT)
  1. D BLD^SDCO S VALMBCK="R"
  1. ENQ Q
  1. ;
  1. PRASK(SDOE) ;Ask Provider on Check Out
  1. ; Input -- SDOE Outpatient Encounter IEN
  1. ; Output -- 0=No, 1=Yes/Required, 2=Yes/Not Required
  1. N SDCL,SDOE0,SDORG,Y
  1. S SDOE0=$G(^SCE(+SDOE,0)),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8)
  1. I $$REQ^SDM1A(+SDOE0)'="CO" G PRASKQ
  1. I SDORG=1,'$$CLINIC^SDAMU(SDCL) G PRASKQ
  1. ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" G PRASKQ ;SD*5.3*466 allow provider check for inpatients
  1. I +SDOE0<2961001 S Y=2 G PRASKQ
  1. I SDCL S Y=1 G PRASKQ
  1. I SDORG=3 S Y=1
  1. PRASKQ Q +$G(Y)
  1. ;
  1. SET(SDOE) ;Set-up Provider Array for Outpatient Encounter
  1. ; Input -- SDOE Outpatient Encounter IEN
  1. ; Output -- SDPRY Provider Array Subscripted by a Number
  1. ; SDCNT Number of Array Entries
  1. N SDVA200,SDVPRV,SDPRVS
  1. K SDPRY
  1. D GETPRV^SDOE(SDOE,"SDPRVS")
  1. S (SDCNT,SDVPRV)=0
  1. F S SDVPRV=$O(SDPRVS(SDVPRV)) Q:'SDVPRV D
  1. . S SDVA200=+$G(SDPRVS(SDVPRV))
  1. . S SDCNT=SDCNT+1
  1. . S SDPRY(SDCNT)=SDVPRV_"^"_SDVA200
  1. SETQ Q
  1. ;
  1. LIST(SDPRY) ;List Provider Array
  1. ; Input -- SDPRY Provider Array Subscripted by a Number
  1. ; Output -- List Provider Array
  1. N I
  1. W !
  1. S I=0 F S I=$O(SDPRY(I)) Q:'I W !?2,I," ",$$PR^SDCO31(+$P(SDPRY(I),"^",2))
  1. Q
  1. ;
  1. EDITOK(SDOE,SDMODE) ; -- ok to edit?
  1. ; input: SDOE := ien of 409.68 [required]
  1. ; SDMODE := 1 -- interactive ; 0 -- silent [required]
  1. ;
  1. ; returned: 1 -- yes, it's ok to edit or delete SDOE entry
  1. ; 0 -- no, cannot not change SDOE entry
  1. ;
  1. N DIR,SDOK
  1. S SDOK=$$NEW^SDPCE($P($G(^SCE(+$G(SDOE),0)),U))
  1. IF 'SDOK,SDMODE=1 D OLDMSG ;*zeb 10/25/18 717 support SDMODE=2 for GUI
  1. EDITOKQ Q SDOK
  1. ;
  1. OLDMSG ; -- display message to user
  1. W !!,">>> Editing and deleting old encounters not allowed.",!
  1. N DIR
  1. S DIR(0)="E"
  1. S DIR("A")="Press Return key to continue"
  1. D ^DIR
  1. Q
  1. ;