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

ACRFRESP.m

Go to the documentation of this file.
  1. ACRFRESP ;IHS/OIRM/DSD/THL,AEF - ADD/EDIT APPROVAL RESPONSE; [ 09/23/2005 9:44 AM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
  1. ;;UTILITY ROUTINE TO ADD/EDIT APPROVAL RESPONSE
  1. RESP ;EP;TO PROCESS RESPONSE TO REQUEST FOR CHANGE OR CLARIFICATION OF A
  1. ;REQUEST
  1. N ACRDOCDT,ACRRESP,ACRINDV,ACRAPDA
  1. D RESP1
  1. Q
  1. RESP1 S ACRDOCDT=$G(^ACRDOC(ACRDOCDA,"DT")),ACRAPDA=$P(ACRDOCDT,U,10)
  1. Q:'ACRAPDA!'+ACRDOCDT!($P(ACRDOCDT,U,2)=1)
  1. S ACRINDV=$G(^ACRAPVS(ACRAPDA,"DT")),ACRINDV=$S($P(ACRINDV,U,6):$P(ACRINDV,U,6),1:$P(ACRINDV,U,2))
  1. Q:'ACRINDV
  1. ;Q:'$D(^VA(200,ACRINDV,0)) S X=$P(^(0),U),ACRINDV=$P($P(X,",",2)," ")_" "_$P(X,",") ;ACR*2.1*19.02 IM16848
  1. Q:'$D(^VA(200,ACRINDV,0)) S X=$$NAME2^ACRFUTL1(ACRINDV),ACRINDV=$P($P(X,",",2)," ")_" "_$P(X,",") ;ACR*2.1*19.02 IM16848
  1. N ACRJ
  1. D APDA^ACRFDISA
  1. I ACRZ>1 D Q:$D(ACRQUIT)!$D(ACROUT)
  1. .S DIR(0)="NO^1:"_ACRZ,DIR("A")="Respond to which message",DIR("B")=1
  1. .W !
  1. .D DIR^ACRFDIC
  1. .S ACRZ=+Y
  1. S DA=ACRAPDA
  1. S DIE="^ACRAPVS("
  1. S DR="[ACR RESPONSE]"
  1. D DDS^ACRFDIC
  1. I $D(ACRSCREN) K ACRSCREN W ! D DIE^ACRFDIC
  1. S ACRRESP=$G(^ACRAPVS(ACRAPDA,"RESP"))
  1. Q:$L(ACRRESP)<3
  1. D NOW^%DTC
  1. S ACRNOW=%
  1. S:ACRZ<1 ACRZ=1
  1. S:$D(^ACRAPVS(ACRAPDA,1,0))#2<1 ^ACRAPVS(ACRAPDA,1,0)="^9002190.01DA"
  1. I '$D(^ACRAPVS(ACRAPDA,1,ACRZ,0)) D
  1. .S X=ACRNOW,DIC="^ACRAPVS("_ACRAPDA_",1,",DA(1)=ACRAPDA,DIC(0)="L"
  1. .D FILE^ACRFDIC
  1. .S ACRZ=+Y
  1. S DIE="^ACRAPVS("_ACRAPDA_",1",DA(1)=ACRAPDA,DA=ACRZ,DR=".03////"_DUZ_";.04////"_ACRNOW
  1. D DIE^ACRFDIC
  1. S ^ACRAPVS(ACRAPDA,1,ACRZ,"RESP")=ACRRESP
  1. S DA=ACRDOCDA
  1. S DIE="^ACRDOC("
  1. S DR="[ACR RESPONSE COMPLETED]"
  1. D DDS^ACRFDIC
  1. Q:'$D(ACRSCREN)
  1. K ACRSCREN
  1. W !
  1. D DIE^ACRFDIC
  1. Q