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

APCDACP2.m

Go to the documentation of this file.
APCDACP2 ; IHS/CMI/LAB - PROC ACC REPORT ;
 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
PROC ;EP;Process and Print ACCEPT commands
 Q:$P(^AUPNVSIT(APCDVDFN,0),U,2)=""
 Q:$P(^AUPNVSIT(APCDVDFN,0),U,11)
 Q:'$P(^AUPNVSIT(APCDVDFN,0),U,9)
 NEW X
 S X=$P(^AUPNVSIT(APCDVDFN,0),U,5)
 Q:$$DEMO^APCLUTL(X,APCLDEMO)
 D @APCDT
 Q
1 ;
 S APCDACCT=1,APCDG="^AUPNVPOV(",APCDFILE=9000010.07,APCDTITL="POV"
 D GETPVS
 Q
2 ;
 S APCDACCT=2,APCDG="^AUPNVPRC(",APCDFILE=9000010.08,APCDTITL="PROCEDURE"
 D GETPVS
 Q
3 ;
 S APCDACCT=3,APCDG="^AUPNVINP(",APCDFILE=9000010.02,APCDTITL="HOSPITALIZATION"
 D GETPVS
 Q
4 ;
 D 1,2,3
 Q
 ;
GETPVS ;
 S APCDVIGR=APCDG_"""AD"",APCDVDFN,APCDEDFN)"
 S APCDEDFN=0 F  S APCDEDFN=$O(@APCDVIGR) Q:APCDEDFN'=+APCDEDFN  D GETPVS1
 K APCDEDFN
 Q
GETPVS1 ;
 I APCDACCT=1,$P(^AUPNVPOV(APCDEDFN,0),U,14)]"" S ^XTMP("APCDACP",$J,"POV",APCDVDFN,APCDEDFN)=""
 I APCDACCT=2,$P(^AUPNVPRC(APCDEDFN,0),U,9)]"" S ^XTMP("APCDACP",$J,"PROCEDURE",APCDVDFN,APCDEDFN)=""
 I APCDACCT=3,$P(^AUPNVINP(APCDEDFN,0),U,14)]"" S ^XTMP("APCDACP",$J,"HOSPITALIZATION",APCDVDFN,APCDEDFN)=""
 Q