source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFC1.m

IBDFC1 ;ALB/CJM - ENCOUNTER FORM - CONVERTED FORMS LIST ;MAR 3, 1995
 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
 ;
LIST ;
 N IBCLINIC,IBTKFORM,IBTKBLK,IBAPI
 S (IBTKFORM,IBTKBLK,IBCLINIC)=""
 S IBAPI("INDEX")="D IDXFORMS^IBDFC1"
 S IBAPI("SELECT")="D SELECT^IBDFC1"
 D EN^VALM("IBDFC CONVERSION LOG")
 D VALMSG^IBDFC
 S VALMBCK="R"
 Q
 ;
ONENTRY ;
 D IDXFORMS
 Q
ONEXIT ;
 K ^TMP("IBDF",$J,"CONVERTED FORMS")
 Q
 ;
HDR ;
 S VALMHDR(1)="           *** LOG OF FORMS THAT HAVE BEEN CONVERTED FOR SCANNING ***"
 Q
 ;
IDXFORMS ;build a list of converted forms
 N IEN
 K @VALMAR
 S VALMCNT=0
 S IEN=0 F  S IEN=$O(^IBD(359,IEN)) Q:'IEN  D ENTRY
 Q
 ;
ENTRY ;adds an entry to the array
 N NODE,FORM,WARNING,REPLACED
 S NODE=$G(^IBD(359,IEN,0))
 Q:NODE=""
 S FORM=+NODE
 S VALMCNT=VALMCNT+1
 S WARNING=$S($O(^IBD(359,IEN,1,0)):"YES",1:"NO ")
 S REPLACED=$S($P(NODE,"^",5):"YES",1:"NO ")
 S @VALMAR@(VALMCNT,0)=$J(VALMCNT,3)_"  "_$$LJ^XLFSTR($P(NODE,"^",3),30)_"  "_$$LJ^XLFSTR($$FMTE^XLFDT($P(NODE,"^",4),"2D"),10)_"  "_$$CJ^XLFSTR(WARNING,8)_"    "_$$CJ^XLFSTR(REPLACED,18)
 D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
 I WARNING="YES" D CNTRL^VALM10(VALMCNT,52,3,IOINHI,IOINORM,0)
 I REPLACED="NO " D CNTRL^VALM10(VALMCNT,69,2,IOINHI,IOINORM,0)
 S @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM_"^"_IEN
 Q
 ;
SELECT ;returns IBFORM,IBCNVRT
 N SEL
 K DIR
 D EN^VALM2(XQORNOD(0),"S")
 S SEL=$O(VALMY(""))
 S IBFORM=$S('SEL:"",1:+$G(@VALMAR@("IDX",SEL,SEL)))
 S IBCNVRT=$S('SEL:"",1:$P($G(@VALMAR@("IDX",SEL,SEL)),"^",2))
 Q
 ;
WARNINGS ;displays conversion warnings
 N IBFORM,IBARY,IBHDRRTN,IBCNVRT
 D SELECT
 Q:'IBCNVRT
 S IBARY="^IBD(359,"_IBCNVRT_",1)"
 S IBHDRRTN="D WARNHDR^IBDFC1"
 D EN^VALM("IBDE TEXT DISPLAY")
 S VALMBCK="R"
 Q
WARNHDR ;
 S VALMHDR(1)="          *** Conversion Warnings For "_$P($G(^IBD(359,IBCNVRT,0)),"^",3)_" ***"
 Q
 ;
DELFORM ;used to delete forms from other places than the clinic setup screen
 N CLINIC,IBFORM,IBCNVRT,BLOCK,NOCANDO,SETUP,ARY
 S NOCANDO=0,ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"
 K @ARY
 S VALMBCK="R"
 I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
 Q:'IBFORM
 D CLINICS^IBDFU4(IBFORM,ARY)
 I $G(@ARY@(0)) D
 .W !,"Cannot be deleted, the form is in use!"
 .D LIST^IBDFU4(ARY,IOSL)
 I '$G(@ARY@(0)) D
 .D DELETE^IBDFU2C(.IBFORM,357,1)
 .I '$G(IBFORM) D
 ..K DIK,DA S DIK="^IBD(359,",DA=IBCNVRT D ^DIK K DIK,DA
 ..D IDXFORMS
 K @ARY
 Q
 ;
PURGE ;purge the conversion log
 N SDATE,IBCNVRT,NODE
 S VALMBCK="R"
 W !,"What is the last dated entry in the conversion log that should be deleted?"
 K DIR S DIR(0)="D"
 S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-25))
 D ^DIR
 I '$D(DIRUT),Y>0,Y'>DT S SDATE=Y D
 .K DIK S DIK="^IBD(359,"
 .S IBCNVRT=0 F  S IBCNVRT=$O(^IBD(359,IBCNVRT)) Q:'IBCNVRT  S NODE=$G(^IBD(359,IBCNVRT,0)) I $P(NODE,"^",4),$P(NODE,"^",4)'>SDATE S DA=IBCNVRT D ^DIK
 .D IDXFORMS
 K DIK,Y,DIR,DA,X
 Q