ACRFRESP.m

ACRFRESP ;IHS/OIRM/DSD/THL,AEF - ADD/EDIT APPROVAL RESPONSE; [ 09/23/2005   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001

 ;;UTILITY ROUTINE TO ADD/EDIT APPROVAL RESPONSE

RESP ;EP;TO PROCESS RESPONSE TO REQUEST FOR CHANGE OR CLARIFICATION OF A

 ;REQUEST

 N ACRDOCDT,ACRRESP,ACRINDV,ACRAPDA

 D RESP1

 Q

RESP1 S ACRDOCDT=$G(^ACRDOC(ACRDOCDA,"DT")),ACRAPDA=$P(ACRDOCDT,U,10)

 Q:'ACRAPDA!'+ACRDOCDT!($P(ACRDOCDT,U,2)=1)

 S ACRINDV=$G(^ACRAPVS(ACRAPDA,"DT")),ACRINDV=$S($P(ACRINDV,U,6):$P(ACRINDV,U,6),1:$P(ACRINDV,U,2))

 Q:'ACRINDV

 ;Q:'$D(^VA(200,ACRINDV,0))  S X=$P(^(0),U),ACRINDV=$P($P(X,",",2)," ")_" "_$P(X,",")  ;ACR*2.1*19.02 IM16848

 Q:'$D(^VA(200,ACRINDV,0))  S X=$$NAME2^ACRFUTL1(ACRINDV),ACRINDV=$P($P(X,",",2)," ")_" "_$P(X,",")  ;ACR*2.1*19.02 IM16848

 N ACRJ

 D APDA^ACRFDISA

 I ACRZ>1 D  Q:$D(ACRQUIT)!$D(ACROUT)

 .S DIR(0)="NO^1:"_ACRZ,DIR("A")="Respond to which message",DIR("B")=1

 .W !

 .D DIR^ACRFDIC

 .S ACRZ=+Y

 S DA=ACRAPDA

 S DIE="^ACRAPVS("

 S DR="[ACR RESPONSE]"

 D DDS^ACRFDIC

 I $D(ACRSCREN) K ACRSCREN W ! D DIE^ACRFDIC

 S ACRRESP=$G(^ACRAPVS(ACRAPDA,"RESP"))

 Q:$L(ACRRESP)<3

 D NOW^%DTC

 S ACRNOW=%

 S:ACRZ<1 ACRZ=1

 S:$D(^ACRAPVS(ACRAPDA,1,0))#2<1 ^ACRAPVS(ACRAPDA,1,0)="^9002190.01DA"

 I '$D(^ACRAPVS(ACRAPDA,1,ACRZ,0)) D

 .S X=ACRNOW,DIC="^ACRAPVS("_ACRAPDA_",1,",DA(1)=ACRAPDA,DIC(0)="L"

 .D FILE^ACRFDIC

 .S ACRZ=+Y

 S DIE="^ACRAPVS("_ACRAPDA_",1",DA(1)=ACRAPDA,DA=ACRZ,DR=".03////"_DUZ_";.04////"_ACRNOW

 D DIE^ACRFDIC

 S ^ACRAPVS(ACRAPDA,1,ACRZ,"RESP")=ACRRESP

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR="[ACR RESPONSE COMPLETED]"

 D DDS^ACRFDIC

 Q:'$D(ACRSCREN)

 K ACRSCREN

 W !

 D DIE^ACRFDIC

 Q

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

 +2       ;;UTILITY ROUTINE TO ADD/EDIT APPROVAL RESPONSE

RESP      ;EP;TO PROCESS RESPONSE TO REQUEST FOR CHANGE OR CLARIFICATION OF A

 +1       ;REQUEST

 +2        NEW ACRDOCDT,ACRRESP,ACRINDV,ACRAPDA

 +3        DO RESP1

 +4        QUIT 

RESP1      SET ACRDOCDT=$GET(^ACRDOC(ACRDOCDA,"DT"))

           SET ACRAPDA=$PIECE(ACRDOCDT,U,10)

 +1        IF 'ACRAPDA!'+ACRDOCDT!($PIECE(ACRDOCDT,U,2)=1)

               QUIT 

 +2        SET ACRINDV=$GET(^ACRAPVS(ACRAPDA,"DT"))

           SET ACRINDV=$SELECT($PIECE(ACRINDV,U,6):$PIECE(ACRINDV,U,6),1:$PIECE(ACRINDV,U,2))

 +3        IF 'ACRINDV

               QUIT 

 +4       ;Q:'$D(^VA(200,ACRINDV,0))  S X=$P(^(0),U),ACRINDV=$P($P(X,",",2)," ")_" "_$P(X,",")  ;ACR*2.1*19.02 IM16848

 +5       ;ACR*2.1*19.02 IM16848

           IF '$DATA(^VA(200,ACRINDV,0))

               QUIT 

           SET X=$$NAME2^ACRFUTL1(ACRINDV)

           SET ACRINDV=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")

 +6        NEW ACRJ

 +7        DO APDA^ACRFDISA

 +8        IF ACRZ>1

               Begin DoDot:1

 +9                SET DIR(0)="NO^1:"_ACRZ

                   SET DIR("A")="Respond to which message"

                   SET DIR("B")=1

 +10               WRITE !

 +11               DO DIR^ACRFDIC

 +12               SET ACRZ=+Y

               End DoDot:1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

 +13       SET DA=ACRAPDA

 +14       SET DIE="^ACRAPVS("

 +15       SET DR="[ACR RESPONSE]"

 +16       DO DDS^ACRFDIC

 +17       IF $DATA(ACRSCREN)

               KILL ACRSCREN

               WRITE !

               DO DIE^ACRFDIC

 +18       SET ACRRESP=$GET(^ACRAPVS(ACRAPDA,"RESP"))

 +19       IF $LENGTH(ACRRESP)<3

               QUIT 

 +20       DO NOW^%DTC

 +21       SET ACRNOW=%

 +22       IF ACRZ<1

               SET ACRZ=1

 +23       IF $DATA(^ACRAPVS(ACRAPDA,1,0))#2<1

               SET ^ACRAPVS(ACRAPDA,1,0)="^9002190.01DA"

 +24       IF '$DATA(^ACRAPVS(ACRAPDA,1,ACRZ,0))

               Begin DoDot:1

 +25               SET X=ACRNOW

                   SET DIC="^ACRAPVS("_ACRAPDA_",1,"

                   SET DA(1)=ACRAPDA

                   SET DIC(0)="L"

 +26               DO FILE^ACRFDIC

 +27               SET ACRZ=+Y

               End DoDot:1

 +28       SET DIE="^ACRAPVS("_ACRAPDA_",1"

           SET DA(1)=ACRAPDA

           SET DA=ACRZ

           SET DR=".03////"_DUZ_";.04////"_ACRNOW

 +29       DO DIE^ACRFDIC

 +30       SET ^ACRAPVS(ACRAPDA,1,ACRZ,"RESP")=ACRRESP

 +31       SET DA=ACRDOCDA

 +32       SET DIE="^ACRDOC("

 +33       SET DR="[ACR RESPONSE COMPLETED]"

 +34       DO DDS^ACRFDIC

 +35       IF '$DATA(ACRSCREN)

               QUIT 

 +36       KILL ACRSCREN

 +37       WRITE !

 +38       DO DIE^ACRFDIC

 +39       QUIT